home *** CD-ROM | disk | FTP | other *** search
/ ETO Development Tools 1 / ETO Development Tools 1.iso / Tools - Objects / MacApp / MacApp 2.0 CD Release / MacApp 2.0 (Many Libraries) / Libraries / UDebug.inc1.p < prev    next >
Encoding:
Text File  |  1990-03-27  |  116.3 KB  |  4,739 lines  |  [TEXT/MPS ]

  1. {$P}
  2. {[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
  3. { UDebug.inc1.p }
  4. { Copyright © 1985-1990 by Apple Computer, Inc.  All rights reserved. }
  5.  
  6. { NMI catcher does not work... probably an A-trap is lowering the priority level }
  7. { Meanwhile, the user can use NMI to get to underlying debuggers (MacsBug, etc.) }
  8.  
  9. {$IFC NOT qDebugTheDebugger}
  10. {$W+}
  11. {$R-}
  12. {$Init-}
  13. {$OV-}
  14. {$ENDC}
  15. {$IFC qNames}
  16. {$D+}
  17. {$ENDC}
  18.  
  19. {$IFC UNDEFINED IncludeDisassembler}
  20. {$SETC IncludeDisassembler := FALSE}                    { Don't automatically include in this version }
  21. {$ENDC}
  22.  
  23. CONST
  24.     kDebugWindowType    = 901;
  25.  
  26.     kHelpRequest        = '?';
  27.     kDontKnow            = ' Huh? ';
  28.  
  29.     kReserve            = 500;                            { Heap space reserved for the debugger's
  30.                                                          use. Too much?, Too little? }
  31.     kRecent             = 63;                            { must be a power of 2 minus 1 }
  32.  
  33.     kDebugSICN            = 901;                            { SICN given to MN }
  34.     { 68000 exception numbers that we intercept }
  35.     exBusError            = 2 * sizeof(Longint);
  36.     exAddressError        = 3 * sizeof(Longint);
  37.     exIllegalInst        = 4 * sizeof(Longint);
  38.     exZeroDivide        = 5 * sizeof(Longint);
  39.     exCheck             = 6 * sizeof(Longint);
  40.     exOverflow            = 7 * sizeof(Longint);
  41.     exLineF             = 11 * sizeof(Longint);
  42.  
  43. TYPE
  44.  
  45.     IEFilePath            = STRING;
  46.     IEFilePathPtr        = ^IEFilePath;
  47.  
  48.     IEFRefNum            = Longint;
  49.     {---}
  50.     ZT                    = (tBegin, tEnd, tExit, tBeginEndPair, { the rest always stop }
  51.                            tProgBreak, tSysError, tVBL, tReadLn);
  52.     ProcPtrPtr            = ^ProcPtr;
  53.  
  54.     HexAddress            = STRING[16];                    { Usually 8-9 chars. Sometimes a _small_
  55.                                                          string constant though. }
  56.  
  57.     QElemWithA5         = RECORD
  58.         OldA5:                Longint;                    { A place to store the old value of A5 since
  59.                                                          when debugging the compiler trashes the
  60.                                                          value of A0 for any locals in the VBL task
  61.                                                          thus makeing the pointer to the
  62.                                                          paramblockrec unavailable }
  63.         A5:                 Longint;                    { The value of A5 will be stored here to be
  64.                                                          available at VBL time }
  65.         q:                    QElem;                        { vbl queue element for changing the cursor}
  66.         END;
  67.  
  68.     VBLInfoPtr            = ^VBLInfo;
  69.     VBLInfo             = RECORD
  70.         aQElemWithA5:        QElemWithA5;                { vbl queue element for changing the cursor
  71.                                                          }
  72.         ch:                 CHAR;                        { character to represent the flag to the
  73.                                                          user with }
  74.         actionProc:         ProcPtr;                    { Pointer to a Proc that takes a boolean. If
  75.                                                          action is required when setting flag }
  76.         desc:                StringHandle;                { a description of the flag's function }
  77.         END;
  78.  
  79.     DebugFEntry         = RECORD
  80.         addr:                BooleanPtr;                 { Pointer to the actual boolean used for the
  81.                                                          flag }
  82.         ch:                 CHAR;                        { character to represent the flag to the
  83.                                                          user with }
  84.         actionProc:         ProcPtr;                    { Pointer to a Proc that takes a boolean. If
  85.                                                          action is required when setting flag }
  86.         desc:                StringHandle;                { a description of the flag's function }
  87.         END;
  88.  
  89.     DebugSEntry         = RECORD
  90.         addr:                Ptr;
  91.         actionProc:         ProcPtr;                    { Pointer to a Function that returns a Ptr.
  92.                                                          If action is required to get addr (pass
  93.                                                          nil for addr) }
  94.         sym:                MAName;
  95.         END;
  96.  
  97.     RecentPC            = RECORD
  98.         thePC:                Longint;
  99.         theZT:                ZT;
  100.         END;
  101.  
  102.     SavedState            = RECORD
  103.         pFocusRec:            FocusRec;                    { Place to stow focus behind MacApp's back }
  104.  
  105.         SaveVisRgn:         RgnHandle;                    { Place to stow the lo-mem save of the
  106.                                                          Vis-Rgn during the Update sequence }
  107.         gCursorRgn:         RgnHandle;                    { the global cursor region }
  108.         gTarget:            TEvtHandler;
  109.         gClickCount:        INTEGER;
  110.         gErrorParm3:        Str255;
  111.         gEventLevel:        INTEGER;
  112.         gIdlePhase:         IdlePhase;
  113.         gInBackground:        BOOLEAN;
  114.         gLastClickPart:     INTEGER;
  115.         gLastDeskAcc:        Longint;
  116.         gLastMsePt:         Point;
  117.         gLastUpTime:        Longint;
  118.         gMainEventMask:     INTEGER;
  119.         gApplication:        TApplication;                { place to stow the application behind
  120.                                                          MacApp's back }
  121.         gBusyTempRgn:        BOOLEAN;
  122.         gUsedBy:            Str255;
  123.         gTempRgn:            RgnHandle;
  124.  
  125.         gIntenseDebugging:    BOOLEAN;
  126.         gDebugPrinting:     BOOLEAN;
  127.         END;
  128.         
  129.     HideType = (RawHide, PartialHide, FullHide);
  130.  
  131.     {$IFC qDebug}
  132.     TDebugApplication    = OBJECT (TApplication)         { Main Event Handler for debug mode, not for
  133.                                                          tracing. }
  134.         PROCEDURE TDebugApplication.IDebugApplication;
  135.         FUNCTION TDebugApplication.DoMenuCommand(aCmdNumber: CmdNumber): TCommand; OVERRIDE;
  136.         FUNCTION TDebugApplication.WMgrToWindow(aWMgrWindow: WindowPtr): TWindow; OVERRIDE;
  137.         FUNCTION TDebugApplication.MenuEvent(menuItem: Longint): TCommand; OVERRIDE;
  138.         FUNCTION TDebugApplication.HandleMouseDown(VAR theEventInfo: EventInfo): TCommand; OVERRIDE;
  139.         FUNCTION TDebugApplication.HandleUpdateEvent(VAR theEventInfo: EventInfo): TCommand;
  140.             OVERRIDE;
  141.         PROCEDURE TDebugApplication.PollEvent(allowApplicationToSleep: BOOLEAN); OVERRIDE;
  142.         PROCEDURE TDebugApplication.HandleEvent(VAR theEvent: EventRecord); OVERRIDE;
  143.         FUNCTION TDebugApplication.HandleAlienEvent(VAR theEventInfo: EventInfo): TCommand; OVERRIDE
  144.             ;
  145.         PROCEDURE TDebugApplication.PostHandleEvent(VAR theEventInfo: EventInfo); OVERRIDE;
  146.         FUNCTION TDebugApplication.HandleKeyDownEvent(VAR theEventInfo: EventInfo): TCommand;
  147.             OVERRIDE;
  148.         FUNCTION TDebugApplication.HandleSystemEvent(VAR theEventInfo: EventInfo): TCommand;
  149.             OVERRIDE;
  150.         END;
  151.     {$EndC}
  152.  
  153. VAR
  154.     {$Push} {$J+}
  155.     pUDebugInitialized: BOOLEAN;
  156.     pCanEnterDebugger:    BOOLEAN;
  157.     pFileName:            Str255;                         { Name of file to intercept for IO }
  158.  
  159.     pDebugWindow:        TWindow;                        { the window object that contains the debug
  160.                                                          window }
  161.     {$Pop}
  162.  
  163.     pMadeNMRequest:     BOOLEAN;                        { Have a pending NM request }
  164.     pNmReq:             NMRec;                            { For notifying user from bg }
  165.     pDisciplineMethodCalls: BOOLEAN;
  166.     pInterceptExceptionVectors: BOOLEAN;                { whether to intercept the 68xxx lo-memory
  167.                                                          exception vectors }
  168.     pCanEnterWriteLn:    BOOLEAN;                        { Flag to keep us from re-entering the
  169.                                                          WriteLn support }
  170.     pAddTextFocusRec:    FocusRec;                        { Place to stow focus behind MacApp's back }
  171.  
  172.     pSavedState:        SavedState;                     { place to record the state of the
  173.                                                          application }
  174.     {$IFC qDebug}
  175.     pDebugApplication:    TDebugApplication;                { the debug event handler }
  176.     {$EndC}
  177.     pDebugView:         TTranscriptView;                { the window object that contains the debug
  178.                                                          window }
  179.     pVBLInfo:            VBLInfo;
  180.  
  181.     pTraceToggle, pTraceEnabled: BOOLEAN;
  182.     pBreakCount:        INTEGER;                        { current number of breakpoints set }
  183.     pBreakClass, pBreakProc: ARRAY [1..10] OF MAName;
  184.     pStackSpace:        Longint;                        { current total stack space; set in %_BP }
  185.     pProcStack:         Longint;                        { current stack space for just last
  186.                                                          procedure to do a %_BP }
  187.     pBreakStack:        Longint;
  188.     pStepOverStackSize: Longint;                        { when stepping the stack to break on if
  189.                                                          same or less }
  190.     pBrProcStack:        Longint;
  191.     pSysErrPatch:        TrapPatch;
  192.     pReserve:            Handle;
  193.  
  194.     pOldexBusError, pOldexAddressError, pOldexIllegalInst, pOldexZeroDivide, pOldexCheck,
  195.     pOldexOverflow, pOldexLineF: ProcPtr;
  196.  
  197.     pMoreMem:            Longint;                        {-1 if no more to see; 0 if more stack trace
  198.                                                          possible, else more memory dump}
  199.     pRecentPC:            ARRAY [0..kRecent] OF RecentPC; { PC ring buffer }
  200.     pRecentIndex:        INTEGER;
  201.  
  202.     pQuietOutput:        BOOLEAN;                        { if TRUE then we should not send trace
  203.                                                          output to debug window }
  204.  
  205.     pMasters:            INTEGER;                        { # available master pointers found by
  206.                                                          latest %_BP or %_EP }
  207.  
  208.     pEnterProc:         Ptr;
  209.     pInspectProc:        Ptr;
  210.     pSymbolProc:        Ptr;
  211.  
  212.     pFlagsInUse:        INTEGER;                        { number of flags currently in use }
  213.     pFlagTable:         ARRAY [1..kMaxFlags] OF DebugFEntry;
  214.     pSymsInUse:         INTEGER;                        { number of symbol table entries in use }
  215.     pSymTable:            ARRAY [1..kMaxSyms] OF DebugSEntry;
  216.  
  217.     pPermFlag:            BOOLEAN;
  218.  
  219.     pTP2PerfGlobals:    TP2PerfGlobals;                 { Pointer to performance globals record
  220.                                                          Non-nil if tools are inited }
  221.  
  222.     fCaptureProc:        ProcPtr;                        { procedure for capturing output; set it
  223.                                                          with DebugCapture }
  224.  
  225.     pFullyHiddenFromMacapp: BOOLEAN;                    { Are we stopped in the read loop }
  226.     pWasAheadOfDebugWindow, pWasFrontWindow: WindowPtr;
  227.     pWasActive:         BOOLEAN;
  228.     pQHdr:                QHdr;                            { Saved Event Queue Header }
  229.     pQSize:             INTEGER;                        { number of events }
  230.  
  231.     discardStr:         MAName;                         { a string that is used as a placeholder in
  232.                                                          any calls where rqd but the result is not
  233.                                                          rqd. Helps to reduce stack requirements }
  234.  
  235.     { the following were locals to MADebuggerMainEntry but… since the debugger is not re-entrant (for now) they can be
  236.     globals and thus available to the procedures that were nested in MADebuggerMainEntry but are no longer.
  237.     Also we knock off about 2k of stack requirements. }
  238.     which:                ZT;
  239.     pLink:                Longint;
  240.     ppc:                Longint;
  241.     aClassName:         MAName;
  242.     aProcName:            MAName;
  243.     aMiscName:            MAName;
  244.     asDecimal, asHex:    Longint;
  245.     pAtBreak:            BOOLEAN;
  246.     callerFrame:        Longint;
  247.     ch:                 CHAR;
  248.     className:            MAName;
  249.     itsFrame:            Longint;
  250.     nextFrame:            Longint;
  251.     nextLevel:            INTEGER;
  252.     {$Ifc qPerform}
  253.     oldState:            BOOLEAN;                        { State of Performance monitoring when
  254.                                                          enterproc called and the state to which
  255.                                                          monitering will return. Performance
  256.                                                          monitering toggle changes this value }
  257.     {$Endc}
  258.     pNextPC:            Longint;
  259.     prevFrame:            Longint;
  260.     procName:            MAName;
  261.     rcvrClass:            MAName;
  262.     rcvrHandle:         HexAddress;
  263.     receiver:            TObject;
  264.     segNum:             INTEGER;
  265.     stkBreak:            BOOLEAN;
  266.     stepBreak:            BOOLEAN;
  267.     str:                MAName;
  268.     waiting:            BOOLEAN;
  269.  
  270. {--------------------------------------------------------------------------------------------------}
  271.     {$Ifc qPerform}
  272.     {$S MADebugger}
  273.  
  274. FUNCTION DebugPerfMonitor(turnOn: BOOLEAN): BOOLEAN;
  275. { Turns performance tracing on and off if installed. }
  276.  
  277.     BEGIN
  278.     IF (pTP2PerfGlobals <> NIL) & pUDebugInitialized THEN
  279.         DebugPerfMonitor := PerfControl(pTP2PerfGlobals, turnOn)
  280.     ELSE
  281.         DebugPerfMonitor := FALSE;
  282.     END;
  283. {$Endc}
  284.  
  285. {$IFC qDebug}
  286. {--------------------------------------------------------------------------------------------------}
  287.  
  288. FUNCTION DevFAccess(fName: UNIV IEFilePathPtr;
  289.                     opCode: Longint;
  290.                     arg: UNIV Longint): Longint;
  291.     C; EXTERNAL;
  292.  
  293. FUNCTION DevClose(fdesc: IEFRefNum): Longint;
  294.     C; EXTERNAL;
  295.  
  296. FUNCTION DevRead(fdesc: IEFRefNum;
  297.                  bufp: UNIV Longint;
  298.                  count: Longint): Longint;
  299.     C; EXTERNAL;
  300.  
  301. FUNCTION DevWrite(fdesc: IEFRefNum;
  302.                   bufp: UNIV Longint;
  303.                   count: Longint): Longint;
  304.     C; EXTERNAL;
  305.  
  306. FUNCTION DevIoctl(fdesc: IEFRefNum;
  307.                   request: Longint;
  308.                   arg: UNIV Longint): Longint;
  309.     C; EXTERNAL;
  310.  
  311. FUNCTION _addDevHandler(slot, dvName, dvFAccess, dvClose, dvRead, dvWrite,
  312.                         dvIoctl: Longint): Longint;
  313.     C; EXTERNAL;
  314.  
  315. {--------------------------------------------------------------------------------------------------}
  316. { The following are assembler routines in UDebug.a }
  317.  
  318. PROCEDURE XDebugSysError;
  319.     EXTERNAL;
  320. { PROCEDURE XDebugNMI;    EXTERNAL; }
  321.  
  322. PROCEDURE XDebugBusError;
  323.     EXTERNAL;
  324.  
  325. PROCEDURE XDebugAddrError;
  326.     EXTERNAL;
  327.  
  328. PROCEDURE XDebugIllInst;
  329.     EXTERNAL;
  330.  
  331. PROCEDURE XDebugZeroDiv;
  332.     EXTERNAL;
  333.  
  334. PROCEDURE XDebugCheck;
  335.     EXTERNAL;
  336.  
  337. PROCEDURE XDebugOverflow;
  338.     EXTERNAL;
  339.  
  340. PROCEDURE XDebugLineF;
  341.     EXTERNAL;
  342.  
  343. PROCEDURE VBLInstall;
  344.     FORWARD;
  345.  
  346. PROCEDURE VBLRemove;
  347.     FORWARD;
  348.  
  349. {--------------------------------------------------------------------------------------------------}
  350.  
  351. FUNCTION SetGetProc(theGetProc: ProcPtr): ProcPtr;
  352.     EXTERNAL;
  353.  
  354. FUNCTION SetPutProc(thePutProc: ProcPtr): ProcPtr;
  355.     EXTERNAL;
  356.  
  357. {--------------------------------------------------------------------------------------------------}
  358.  
  359. FUNCTION CallSymActionProc(actionProc: ProcPtr): Handle;
  360.     INLINE $205F, $4E90;
  361. {  MOVE.L  (A7)+,A0
  362. JSR (A0)
  363. }
  364.  
  365. FUNCTION CallSymbolLookup(VAR sym: Str255;
  366.                           lookerUpper: Ptr): Longint;
  367.     INLINE $205F, $4E90;
  368. {  MOVE.L  (A7)+,A0
  369. JSR (A0)
  370. }
  371.  
  372. PROCEDURE CallInspector(obj: TObject;
  373.                         inspector: Ptr);
  374.     INLINE $205F, $4E90;
  375. {  MOVE.L  (A7)+,A0
  376. JSR (A0)
  377. }
  378.  
  379. FUNCTION CallFlagActionProc(OnOrOff: BOOLEAN;
  380.                             actionProc: ProcPtr): BOOLEAN;
  381.     INLINE $205F, $4E90;
  382. { MOVE.L (A7)+,A0
  383. JSR (A0)
  384. }
  385.  
  386. PROCEDURE CallEnter(entering: BOOLEAN;
  387.                     proc: Ptr);
  388.     INLINE $205F, $4E90;
  389. {  MOVE.L  (A7)+,A0
  390. JSR (A0)
  391. }
  392.  
  393. PROCEDURE CallCapture(textBuf: Ptr;
  394.                       byteCount: INTEGER;
  395.                       captureProc: ProcPtr);
  396.     INLINE $205F, $4E90;
  397. { MOVEA.L (A7)+,A0
  398. JSR (A0)
  399. }
  400.  
  401. PROCEDURE MainHelpProc;
  402.     FORWARD;
  403.  
  404. {--------------------------------------------------------------------------------------------------}
  405. {$S MADebugger}
  406.  
  407. PROCEDURE CurrentCursor(VAR C: Cursor);
  408.  
  409.     BEGIN
  410.     BlockMove(Ptr(GetTheCrsr), Ptr(@C), sizeof(Cursor));
  411.     END;
  412.  
  413. {--------------------------------------------------------------------------------------------------}
  414. {$S MADebugger}
  415.  
  416. FUNCTION YouAreWarned: BOOLEAN;
  417. { Returns true if the super secret power keys are held down.
  418. Used to indicate to the debugger that the programmer wants to flirt with _DANGER_!
  419. If you do this then you're _ON_YOUR_OWN. }
  420.  
  421.     VAR
  422.         aKeyMap:            KeyMap;
  423.         oldState:            INTEGER;
  424.  
  425.     BEGIN
  426.     oldState := IntegerPtr(JournalFlag)^;
  427.     IntegerPtr(JournalFlag)^ := 0;                        { turn off journaling }
  428.     GetKeys(aKeyMap);
  429.     IntegerPtr(JournalFlag)^ := oldState;
  430.     IF aKeyMap[$3B] THEN
  431.         YouAreWarned := true
  432.     ELSE
  433.         YouAreWarned := FALSE;
  434.     END;
  435.  
  436. {--------------------------------------------------------------------------------------------------}
  437. {$S MADebugger}
  438.  
  439. PROCEDURE TDebugApplication.IDebugApplication;
  440.  
  441.     VAR
  442.         aCommandList:        TCommandList;
  443.  
  444.     BEGIN
  445.     fTicksOfLastIdle := 0;
  446.     fTicksTilNextIdle := 0;
  447.     fCommandQueue := NIL;
  448.     fLastCommand := NIL;
  449.  
  450.     IEvtHandler(NIL);
  451.  
  452.     New(aCommandList);
  453.     FailNil(aCommandList);
  454.     aCommandList.ICommandList;
  455.     fCommandQueue := aCommandList;
  456.     {$IFC qDebug}
  457.     fCommandQueue.SetEltType('TCommand');
  458.     {$ENDC}
  459.  
  460.     END;
  461.  
  462. {--------------------------------------------------------------------------------------------------}
  463. {$S MADebugger}
  464.  
  465. FUNCTION TDebugApplication.WMgrToWindow(aWMgrWindow: WindowPtr): TWindow;
  466.  
  467.     VAR
  468.         theWindow:            TWindow;
  469.  
  470.     BEGIN
  471.     theWindow := INHERITED WMgrToWindow(aWMgrWindow);
  472.     { Make sure we only operate on debugger windows here }
  473.     IF (theWindow <> pDebugWindow) & (NOT YouAreWarned) THEN
  474.         theWindow := NIL;
  475.     WMgrToWindow := theWindow;
  476.     END;
  477.  
  478. {--------------------------------------------------------------------------------------------------}
  479. {$S MADebugger}
  480.  
  481. FUNCTION TDebugApplication.DoMenuCommand(aCmdNumber: CmdNumber): TCommand;
  482.  
  483.     BEGIN
  484.     IF YouAreWarned THEN
  485.         DoMenuCommand := INHERITED DoMenuCommand(aCmdNumber)
  486.     ELSE
  487.         BEGIN
  488.         DoMenuCommand := NIL;
  489.         CASE aCmdNumber OF
  490.             cQuit:
  491.                 BEGIN
  492.                 { Be kind to those with TApplication.Close routines }
  493.                 IF pSavedState.gApplication <> NIL THEN
  494.                     gApplication := pSavedState.gApplication;
  495.                 ExitToShell;
  496.                 END;
  497.         END;
  498.         END;
  499.     END;
  500.  
  501. {--------------------------------------------------------------------------------------------------}
  502. {$S MADebugger}
  503.  
  504. FUNCTION TDebugApplication.HandleUpdateEvent(VAR theEventInfo: EventInfo): TCommand;
  505.  
  506.     BEGIN
  507.     IF pDebugWindow.HasPendingUpdate THEN
  508.         BEGIN
  509.         pDebugWindow.Update;
  510.         HandleUpdateEvent := NIL;
  511.         END
  512.     ELSE
  513.         HandleUpdateEvent := INHERITED HandleUpdateEvent(theEventInfo);
  514.     END;
  515.  
  516. {--------------------------------------------------------------------------------------------------}
  517. {$S MADebugger}
  518.  
  519. FUNCTION TDebugApplication.MenuEvent(menuItem: Longint): TCommand;
  520.  
  521.     VAR
  522.         fi:                 FailInfo;
  523.         cmd:                CmdNumber;
  524.         deskAccName:        Str255;
  525.         theMenuNumber:        INTEGER;
  526.         theItemNumber:        INTEGER;
  527.         savedPort:            GrafPtr;
  528.  
  529.     BEGIN
  530.     MenuEvent := NIL;
  531.  
  532.     theMenuNumber := HiWrd(menuItem);
  533.     theItemNumber := LoWrd(menuItem);
  534.  
  535.     IF theMenuNumber <> 0 THEN
  536.         BEGIN
  537.  
  538.         cmd := CmdFromMenuItem(theMenuNumber, theItemNumber);
  539.  
  540.         IF (cmd < 0) & (theMenuNumber = mApple) THEN
  541.             BEGIN
  542.             GetItem(MAGetMenu(mApple), theItemNumber, deskAccName);
  543.             GetPort(savedPort);
  544.             IF OpenDeskAcc(deskAccName) = noErr THEN;    { MultiFinder be good to us! }
  545.             SetPort(savedPort);
  546.             END
  547.         ELSE IF (cmd < cEditBase) | (cmd > cEditLast) | (NOT SystemEdit(cmd - cEditBase)) THEN
  548.             BEGIN
  549.  
  550.             MenuEvent := gTarget.DoMenuCommand(cmd)
  551.  
  552.             END;
  553.         END;
  554.     END;
  555.  
  556. {--------------------------------------------------------------------------------------------------}
  557. {$S MADebugger}
  558.  
  559. FUNCTION TDebugApplication.HandleMouseDown(VAR theEventInfo: EventInfo): TCommand;
  560.  
  561.     VAR
  562.         doClick:            BOOLEAN;
  563.         aWindow:            TWindow;
  564.         aWMgrWindow:        WindowPtr;
  565.         whereMouseDown:     INTEGER;
  566.         sysWindowAct:        BOOLEAN;
  567.         aCommand:            TCommand;
  568.         theMouse:            Point;
  569.         theVMouse:            VPoint;
  570.         hysteresis:         Point;
  571.  
  572.     BEGIN
  573.     HandleMouseDown := NIL;
  574.  
  575.     WITH theEventInfo, thePEvent^ DO
  576.         BEGIN
  577.         whereMouseDown := FindWindow(where, aWMgrWindow);
  578.         aWindow := WMgrToWindow(aWMgrWindow);
  579.         END;
  580.  
  581.     IF whereMouseDown <> inContent THEN
  582.         SetCursor(arrow);
  583.  
  584.     WITH theEventInfo, thePEvent^ DO
  585.         CASE whereMouseDown OF
  586.             inMenuBar:
  587.                 BEGIN
  588.                 HandleMouseDown := MenuEvent(MenuSelect(where));
  589.                 END;
  590.  
  591.             inSysWindow:
  592.                 SystemClick(thePEvent^, aWMgrWindow);
  593.  
  594.             OTHERWISE
  595.                     { if a MacApp window was associated with the WindowPtr then let the window object
  596.                     decide what to do with the mouse click }
  597.                 IF (aWindow <> NIL) & aWindow.Focus THEN { if we can't focus, we're in trouble }
  598.                     BEGIN
  599.                     theMouse := where;
  600.                     GlobalToLocal(theMouse);
  601.                     aWindow.QDToViewPt(theMouse, theVMouse);
  602.                     hysteresis := gStdHysteresis;        { don't want std changed by var }
  603.                     IF aWindow.HandleMouseDown(theVMouse, theEventInfo, hysteresis, aCommand) &
  604.                        (aCommand <> NIL) THEN
  605.                         BEGIN
  606.                         aCommand.fTracksMouse := true;    {??? someday this won't be forced }
  607.                         aCommand.fInitialPt := where;    {??? someday this won't be forced }
  608.                         HandleMouseDown := aCommand;
  609.                         END;
  610.                     END
  611.                 ELSE IF qDebug THEN
  612.                     BEGIN
  613.                     IF aWindow <> NIL THEN
  614.                         ProgramBreak(
  615.                               'In TApplication.HandleMouseDown: couldn''t focus on a window object!'
  616.                                      )
  617.                     ELSE IF gIntenseDebugging THEN
  618.                         WriteLn('Got a mouse event for a non-MacApp, non-system window');
  619.                     END;
  620.  
  621.         END;
  622.     END;
  623.  
  624. {--------------------------------------------------------------------------------------------------}
  625. {$S MADebugger}
  626.  
  627. PROCEDURE SaveEventQueue(save: BOOLEAN);
  628.  
  629.     CONST
  630.         kLMEvtBufCnt        = $154;
  631.  
  632.     BEGIN
  633.     IF save THEN
  634.         BEGIN
  635.         { Save the existing event queue }
  636.         pQHdr := GetEvQHdr^;
  637.         WITH GetEvQHdr^ DO
  638.             BEGIN
  639.             qFlags := 0;
  640.             qHead := NIL;
  641.             qTail := NIL;
  642.             END;
  643.         pQSize := IntegerPtr(kLMEvtBufCnt)^;
  644.         END
  645.     ELSE
  646.         BEGIN
  647.         { Restore the event queue }
  648.         FlushEvents(everyEvent, 0);
  649.         GetEvQHdr^ := pQHdr;
  650.         IntegerPtr(kLMEvtBufCnt)^ := pQSize;
  651.         END;
  652.     END;
  653.  
  654. {--------------------------------------------------------------------------------------------------}
  655. {$S MADebugger}
  656.  
  657. FUNCTION DebugGetActiveWindow: TWindow;
  658.  
  659.     VAR
  660.         oldFloats:            BOOLEAN;
  661.  
  662.     BEGIN
  663.     oldFloats := pDebugWindow.fFloats;
  664.     pDebugWindow.fFloats := FALSE;                        { so the debugger window doesn't get
  665.                                                          reported }
  666.     DebugGetActiveWindow := gApplication.GetActiveWindow;
  667.     pDebugWindow.fFloats := FALSE;
  668.     END;
  669.  
  670. {--------------------------------------------------------------------------------------------------}
  671. {$S MADebugger}
  672.  
  673. FUNCTION DebugGetActiveDocument: TDocument;
  674.  
  675.     BEGIN
  676.     IF DebugGetActiveWindow <> NIL THEN
  677.         DebugGetActiveDocument := DebugGetActiveWindow.fDocument
  678.     ELSE
  679.         DebugGetActiveDocument := NIL;
  680.     END;
  681.  
  682. {--------------------------------------------------------------------------------------------------}
  683. {$S MADebugger}
  684.  
  685. FUNCTION DebugGetLastCommand: TCommand;
  686.  
  687.     BEGIN
  688.     IF pSavedState.gTarget <> NIL THEN
  689.         DebugGetLastCommand := pSavedState.gTarget.GetLastCommand
  690.     ELSE
  691.         DebugGetLastCommand := NIL;
  692.     END;
  693.  
  694. {--------------------------------------------------------------------------------------------------}
  695. {$S MADebugger}
  696.  
  697. PROCEDURE ExchangeHandles(VAR handle1, handle2: UNIV Handle);
  698.  
  699.     VAR
  700.         savedHandle:        Handle;
  701.  
  702.     BEGIN
  703.     savedHandle := handle1;
  704.     handle1 := handle2;
  705.     handle2 := savedHandle;
  706.     END;
  707.  
  708. {--------------------------------------------------------------------------------------------------}
  709. {$S MADebugger}
  710.  
  711. FUNCTION TDebugApplication.HandleKeyDownEvent(VAR theEventInfo: EventInfo): TCommand;
  712.  
  713.     VAR
  714.         ch:                 CHAR;
  715.         keycode:            INTEGER;
  716.  
  717.     BEGIN
  718.     WITH theEventInfo, thePEvent^ DO
  719.         BEGIN
  720.         ch := CHR(BAND(message, charCodeMask));
  721.         keycode := BSR(BAND(message, keyCodeMask), 8);
  722.  
  723.         IF theCmdKey & YouAreWarned THEN
  724.             HandleKeyDownEvent := gTarget.DoCommandKey(ch, theEventInfo)
  725.         ELSE
  726.             HandleKeyDownEvent := gTarget.DoKeyCommand(ch, keycode, theEventInfo);
  727.         END;
  728.     END;
  729.  
  730. {--------------------------------------------------------------------------------------------------}
  731. {$S MADebugger}
  732.  
  733. PROCEDURE RemoveAnyNMRequests;
  734.  
  735.     BEGIN
  736.     IF pMadeNMRequest THEN
  737.         BEGIN
  738.         pMadeNMRequest := FALSE;
  739.         IF gConfiguration.systemVersion >= $0600 THEN
  740.             BEGIN
  741.             FailOSErr(NMRemove(QElemPtr(@pNmReq)));
  742.             ReleaseResource(pNmReq.nmSIcon);
  743.             END;
  744.  
  745.         END;
  746.     END;
  747.  
  748. {--------------------------------------------------------------------------------------------------}
  749. {$S MADebugger}
  750.  
  751. PROCEDURE InstallAnNMRequest;
  752.  
  753.     BEGIN
  754.     IF NOT pMadeNMRequest THEN
  755.         BEGIN
  756.         pMadeNMRequest := true;
  757.         IF gConfiguration.systemVersion >= $0600 THEN
  758.             BEGIN
  759.             WITH pNmReq DO
  760.                 BEGIN
  761.                 qType := nmType;
  762.                 nmMark := 1;                            { mark in Apple menu }
  763.                 nmSIcon := GetResource('SICN', kDebugSICN); {handle to small icon}
  764.                 IF nmSIcon <> NIL THEN
  765.                     HNoPurge(nmSIcon);
  766.                 nmSound := Handle( - 1);                {handle to sound record}
  767.                 nmStr := NIL;                            {string to appear in alert}
  768.                 nmResp := NIL;                            {pointer to response routine}
  769.                 nmRefCon := 0;                            {for application use}
  770.                 END;
  771.             FailOSErr(NMInstall(QElemPtr(@pNmReq)));
  772.             END;
  773.  
  774.         END;
  775.     END;
  776.  
  777. {--------------------------------------------------------------------------------------------------}
  778. {$S MADebugger}
  779.  
  780. FUNCTION TDebugApplication.HandleSystemEvent(VAR theEventInfo: EventInfo): TCommand;
  781.  
  782.     VAR
  783.         switchingIn:        BOOLEAN;
  784.         convertClipboard:    BOOLEAN;
  785.         aWindow:            TWindow;
  786.  
  787.     BEGIN
  788.  
  789.     IF NOT YouAreWarned THEN
  790.         BEGIN
  791.         WITH theEventInfo.thePEvent^ DO
  792.             CASE BSR(message, 24) OF
  793.                 kSuspendOrResume:
  794.                     BEGIN
  795.                     switchingIn := Odd(message);
  796.                     IF pDebugWindow.fWMgrWindow = FrontWindow THEN
  797.                         pDebugWindow.Activate(switchingIn);
  798.                     gInBackground := NOT switchingIn;    { for MacApp }
  799.                     RemoveAnyNMRequests;
  800.                     END;
  801.             END;
  802.         END
  803.     ELSE
  804.         WITH theEventInfo.thePEvent^ DO
  805.             CASE BSR(BAND(message, $FF000000), 24) OF
  806.                 kSuspendOrResume:
  807.                     BEGIN
  808.                     switchingIn := Odd(message);
  809.                     convertClipboard := BAND(message, $00000002) <> 0;
  810.  
  811.                     IF switchingIn THEN
  812.                         RegainControl(convertClipboard)
  813.                     ELSE
  814.                         AboutToLoseControl(convertClipboard);
  815.  
  816.                     IF switchingIn THEN
  817.                         aWindow := GetFrontWindow
  818.                     ELSE
  819.                         aWindow := GetActiveWindow;
  820.  
  821.                     IF aWindow <> NIL THEN
  822.                         aWindow.Activate(switchingIn);
  823.                     gInBackground := NOT switchingIn;
  824.                     RemoveAnyNMRequests;
  825.                     END;
  826.             END;
  827.  
  828.     HandleSystemEvent := NIL;
  829.     END;
  830.  
  831. {--------------------------------------------------------------------------------------------------}
  832. {$S MADebugger}
  833.  
  834. FUNCTION TDebugApplication.HandleAlienEvent(VAR theEventInfo: EventInfo): TCommand;
  835. { In the debugger we don't send events down the co-handler chain. }
  836.  
  837.     BEGIN
  838.     HandleAlienEvent := NIL;
  839.     END;
  840.  
  841. {--------------------------------------------------------------------------------------------------}
  842. {$S MADebugger}
  843.  
  844. PROCEDURE TDebugApplication.HandleEvent(VAR theEvent: EventRecord);
  845.  
  846.     VAR
  847.         fi:                 FailInfo;
  848.         commandToPerform:    TCommand;
  849.         theEventInfo:        EventInfo;
  850.  
  851.     BEGIN
  852.     WITH theEventInfo, theEvent DO
  853.         BEGIN
  854.         thePEvent := @theEvent;
  855.         theBtnState := BAND(modifiers, btnState) <> 0;
  856.         theCmdKey := BAND(modifiers, cmdKey) <> 0;
  857.         theShiftKey := BAND(modifiers, shiftKey) <> 0;
  858.         theAlphaLock := BAND(modifiers, alphaLock) <> 0;
  859.         theOptionKey := BAND(modifiers, optionKey) <> 0;
  860.         theControlKey := BAND(modifiers, controlKey) <> 0;
  861.         theAutoKey := what = autoKey;
  862.         theClickCount := gClickCount;
  863.         affectsMenus := true;                            { assume going in that this event affects
  864.                                                          the menus }
  865.         IF NOT YouAreWarned THEN
  866.             affectsMenus := FALSE;                        { not in the debugger they don't }
  867.         END;
  868.  
  869.     DispatchEvent(theEventInfo, commandToPerform);
  870.     IF (commandToPerform = NIL) THEN
  871.         commandToPerform := GetNextCommand;
  872.  
  873.     IF (commandToPerform <> NIL) & (commandToPerform <> NIL) THEN
  874.         PerformCommand(commandToPerform);
  875.  
  876.     IF YouAreWarned THEN
  877.         PostHandleEvent(theEventInfo);
  878.  
  879.     END;
  880.  
  881. {--------------------------------------------------------------------------------------------------}
  882. {$S MADebugger}
  883.  
  884. PROCEDURE TDebugApplication.PostHandleEvent(VAR theEventInfo: EventInfo);
  885.  
  886.     VAR
  887.         sysWindowAct:        BOOLEAN;
  888.         perm:                BOOLEAN;
  889.  
  890.     BEGIN
  891.     IF MenuBarHasPendingUpdate THEN                     { application wants menu bar redrawn }
  892.         SetupTheMenus                                    { …so draw it immediately. }
  893.     ELSE IF theEventInfo.affectsMenus THEN
  894.         InvalidateMenus;
  895.  
  896.     { See if a system window has been activated or deactivated. }
  897.     sysWindowAct := IsDeskAccessory(FrontWindow);
  898.  
  899.     IF sysWindowAct <> gSysWindowActive THEN
  900.         BEGIN
  901.         gSysWindowActive := sysWindowAct;
  902.  
  903.         IF gSysWindowActive THEN                        { deactivating to sys window }
  904.             BEGIN
  905.             AboutToLoseControl(true);
  906.             InvalidateMenuBar;
  907.             END
  908.         ELSE                                            { coming back from sys window }
  909.             RegainControl(true);
  910.         END;
  911.  
  912.     END;
  913.  
  914. {--------------------------------------------------------------------------------------------------}
  915. {$S MADebugger}
  916.  
  917. PROCEDURE TDebugApplication.PollEvent(allowApplicationToSleep: BOOLEAN);
  918.  
  919.     LABEL 1000;
  920.  
  921.     VAR
  922.         ch:                 CHAR;
  923.         theEvent:            EventRecord;
  924.         theEventInfo:        EventInfo;
  925.         r:                    Rect;
  926.         aPartCode:            INTEGER;
  927.         aWMgrWindow:        WindowPtr;
  928.  
  929.         savePort:            GrafPtr;
  930.         savedScript:        INTEGER;
  931.  
  932.         switchingIn:        BOOLEAN;
  933.         pt:                 Point;
  934.         haveChar:            BOOLEAN;
  935.         aEvQElPtr:            EvQElPtr;
  936.         aMessage:            Longint;
  937.         aCommand:            TCommand;
  938.         keycode:            INTEGER;
  939.         hasEvent:            BOOLEAN;
  940.         commandToPerform:    TCommand;
  941.         fi:                 FailInfo;
  942.  
  943.     PROCEDURE HdlPollEvt(error: INTEGER;
  944.                          message: Longint);
  945.  
  946.         BEGIN
  947.         {$IFC qDebug}
  948.         WriteLn;                                        { add a blank line after all the messages
  949.                                                          from Failure }
  950.         {$ENDC}
  951.         gEventLevel := gEventLevel - 1;
  952.         BEGIN
  953.         IF error <> noErr THEN
  954.             BEGIN
  955.             ShowError(error, message);
  956.             END;
  957.         HiliteMenu(0);                                    { Make sure menu isn't left highlighted. }
  958.         GOTO 1000;                                        { Keep the application running. }
  959.         END;
  960.         END;
  961.  
  962.     BEGIN
  963.     gEventLevel := gEventLevel + 1;
  964.     CatchFailures(fi, HdlPollEvt);
  965.     PLflush(output);                                    { guarantee that user can see prompts }
  966.  
  967.     { Blow off the focus }
  968.     gFocusedView := NIL;
  969.  
  970.     IF NOT gInBackground THEN
  971.         HiliteMenu(mDebug);
  972.  
  973.     IF NOT pDebugWindow.IsShown THEN
  974.         BEGIN
  975.         pDebugWindow.Open;
  976.         pDebugView.RevealInsertionPoint;
  977.         END;
  978.  
  979.     SetCursor(arrow);
  980.     IF gTarget.DoIdle(idleBegin) THEN;
  981.  
  982.     IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
  983.         savedScript := SetKeyScript(Font2Script(GrafPtr(pDebugWindow.fWMgrWindow)^.txFont));
  984.  
  985.     { IF we have any queued commands that have not otherwise been taken care of, now is the time. }
  986.  
  987.     commandToPerform := GetNextCommand;
  988.     IF commandToPerform <> NIL THEN
  989.         PerformCommand(commandToPerform);
  990.  
  991.     IF qNeedsWaitNextEvent | gConfiguration.hasWaitNextEvent THEN
  992.         hasEvent := WaitNextEvent(everyEvent, theEvent, GetCaretTime, NIL)
  993.     ELSE
  994.         BEGIN
  995.         SystemTask;
  996.         hasEvent := GetNextEvent(everyEvent, theEvent)
  997.         END;
  998.  
  999.     IF hasEvent THEN
  1000.         BEGIN
  1001.         { package it }
  1002.         HandleEvent(theEvent);
  1003.  
  1004.         END;
  1005.  
  1006.     Success(fi);
  1007.     gEventLevel := gEventLevel - 1;
  1008.  
  1009. 1000:                                                    { Failure re-entry point }
  1010.     IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
  1011.         savedScript := SetKeyScript(savedScript);
  1012.     END;
  1013.  
  1014. {--------------------------------------------------------------------------------------------------}
  1015. {$S MADebugger}
  1016.  
  1017. PROCEDURE WithHideFromMacAppDo(PROCEDURE WhatToDo;
  1018.                                itsHideType: HideType);
  1019. {
  1020. Intended for doit behind macapp's back stuff.
  1021. Fullhide indicates whether to give enough support to fully stop in the debugger
  1022. }
  1023.  
  1024.     VAR
  1025.         oldPerm:            BOOLEAN;
  1026.         oldpCanEnterDebugger: BOOLEAN;
  1027.  
  1028.         oldpFullyHiddenFromMacapp: BOOLEAN;
  1029.         oldpDisciplineMethodCalls: BOOLEAN;
  1030.         oldDebugWindowNextHandler: TEvtHandler;
  1031.         fi:                 FailInfo;
  1032.         OldA5:                Longint;
  1033.         saveResLoad:        BOOLEAN;
  1034.         saveResFile:        INTEGER;
  1035.  
  1036.  
  1037.     PROCEDURE UnloadActivateEvents;
  1038. { Activate events are manufactured by the window manager
  1039. Thus they need to be preserved. The activate event if any
  1040. is retrieved then the procedure recursed to get any more.  Then
  1041. the events are reposted on the application event queue. }
  1042.  
  1043.         VAR
  1044.             theEvent:            EventRecord;
  1045.             aEvQElPtr:            EvQElPtr;
  1046.  
  1047.         BEGIN
  1048.         IF GetNextEvent(activMask, theEvent) THEN
  1049.             BEGIN
  1050.             UnloadActivateEvents;                        { recurse to get more }
  1051.             WITH theEvent DO
  1052.                 BEGIN
  1053.                 IF (PPostEvent(activateEvt, message, aEvQElPtr)) = noErr THEN
  1054.                     aEvQElPtr^.evtQmodifiers := modifiers;
  1055.                 END;
  1056.             END;
  1057.         END;
  1058.  
  1059.     PROCEDURE MiniHide;
  1060.         BEGIN
  1061.         OldA5 := SetCurrentA5;                                {}
  1062.         saveResLoad := GetResLoad;
  1063.         SetResLoad(TRUE);
  1064.         saveResFile := MAUseResFile(gApplicationRefNum);
  1065.         END;
  1066.  
  1067.     PROCEDURE MiniShow;
  1068.         BEGIN
  1069.         IF MAUseResFile(saveResFile) = 0 THEN ;
  1070.         SetResLoad(saveResLoad);
  1071.         OldA5 := SetA5(OldA5);
  1072.         END;
  1073.  
  1074.     PROCEDURE HideFromMacApp;
  1075.  
  1076.         BEGIN
  1077.         MiniHide; { Everyone has to do a MiniHide }
  1078.         oldpFullyHiddenFromMacapp := pFullyHiddenFromMacapp;
  1079.         IF NOT oldpFullyHiddenFromMacapp THEN
  1080.             Case itsHideType of
  1081.             RawHide:
  1082.                 ; { Already done }
  1083.  
  1084.             PartialHide:
  1085.                 BEGIN
  1086.                 oldpCanEnterDebugger := pCanEnterDebugger;
  1087.                 pSavedState.gIntenseDebugging := gIntenseDebugging;
  1088.                 pSavedState.gDebugPrinting := gDebugPrinting;
  1089.  
  1090.                 pCanEnterDebugger := FALSE;
  1091.                 gDebugPrinting := FALSE;
  1092.                 gIntenseDebugging := FALSE;
  1093.  
  1094.                 oldPerm := PermAllocation(FALSE);
  1095.                 oldpDisciplineMethodCalls := DisciplineMethodCalls(FALSE);
  1096.  
  1097.                 GetFocus(pSavedState.pFocusRec);
  1098.                 gPrinting := FALSE;
  1099.                 gDrawingPictScrap := FALSE;
  1100.                 gDrawingPictScrapView := NIL;
  1101.  
  1102.                 pSavedState.gBusyTempRgn := gBusyTempRgn;
  1103.                 pSavedState.gUsedBy := gUsedBy;
  1104.  
  1105.                 gBusyTempRgn := FALSE;
  1106.                 gUsedBy := '';
  1107.                 ExchangeHandles(pSavedState.gTempRgn, gTempRgn);
  1108.                 ExchangeHandles(pSavedState.SaveVisRgn, GetSaveVisRgnPtr^);
  1109.  
  1110.                 END;
  1111.  
  1112.             FullHide:
  1113.                 BEGIN
  1114.                 pFullyHiddenFromMacapp := true;
  1115.                 { make sure this is set to FALSE in case of new EXIT statements }
  1116.                 pPermFlag := PermAllocation(FALSE);
  1117.                 pDisciplineMethodCalls := DisciplineMethodCalls(FALSE);
  1118.                 ShowCursor;
  1119.                 pDebugView.fHelpProc := NIL;
  1120.                 oldDebugWindowNextHandler := pDebugWindow.fNextHandler;
  1121.                 pDebugWindow.fNextHandler := pDebugApplication;
  1122.  
  1123.                 ExchangeHandles(pSavedState.SaveVisRgn, GetSaveVisRgnPtr^);
  1124.  
  1125.                 pSavedState.gTarget := gTarget;
  1126.                 pSavedState.gClickCount := gClickCount;
  1127.                 pSavedState.gErrorParm3 := gErrorParm3;
  1128.                 pSavedState.gEventLevel := gEventLevel;
  1129.                 pSavedState.gIdlePhase := gIdlePhase;
  1130.                 pSavedState.gInBackground := gInBackground;
  1131.                 pSavedState.gLastClickPart := gLastClickPart;
  1132.                 pSavedState.gLastDeskAcc := gLastDeskAcc;
  1133.                 pSavedState.gLastMsePt := gLastMsePt;
  1134.                 pSavedState.gLastUpTime := gLastUpTime;
  1135.                 pSavedState.gMainEventMask := gMainEventMask;
  1136.                 pSavedState.gApplication := gApplication;
  1137.                 pSavedState.gIntenseDebugging := gIntenseDebugging;
  1138.                 pSavedState.gDebugPrinting := gDebugPrinting;
  1139.  
  1140.                 pSavedState.gBusyTempRgn := gBusyTempRgn;
  1141.                 gBusyTempRgn := FALSE;
  1142.                 pSavedState.gUsedBy := gUsedBy;
  1143.                 gUsedBy := '';
  1144.                 ExchangeHandles(pSavedState.gTempRgn, gTempRgn);
  1145.                 ExchangeHandles(pSavedState.gCursorRgn, gCursorRgn);
  1146.  
  1147.                 GetFocus(pSavedState.pFocusRec);
  1148.  
  1149.                  {### NO! pDebugApplication.InvalidateFocus; }
  1150.  
  1151.                 gPrinting := FALSE;
  1152.                 gDrawingPictScrap := FALSE;
  1153.                 gDrawingPictScrapView := NIL;
  1154.  
  1155.                 gApplication := pDebugApplication;
  1156.                 gIntenseDebugging := FALSE;
  1157.                 gDebugPrinting := FALSE;
  1158.  
  1159.                 { Now blow the Focus }
  1160.                 gFocusedView := NIL;
  1161.  
  1162.                 gTarget := pDebugView;
  1163.  
  1164.                 UnloadActivateEvents;
  1165.                 SaveEventQueue(true);
  1166.  
  1167.                 pWasAheadOfDebugWindow := FindWindowBefore(pDebugWindow.fWMgrWindow);
  1168.                 IF FrontWindow <> pDebugWindow.fWMgrWindow THEN
  1169.                     pWasFrontWindow := FrontWindow
  1170.                 ELSE
  1171.                     pWasFrontWindow := NIL;
  1172.  
  1173.                 pWasActive := pDebugWindow.fIsActive;
  1174.  
  1175.                 IF NOT pWasActive THEN
  1176.                     BEGIN
  1177.                     IF NOT pDebugWindow.IsShown THEN
  1178.                         pDebugWindow.Open;
  1179.                     IF true | NOT gInBackground THEN
  1180.                         BEGIN
  1181.                         HiliteWindow(pDebugWindow.fWMgrWindow, true);
  1182.                         IF pWasFrontWindow <> NIL THEN
  1183.                             HiliteWindow(pWasFrontWindow, FALSE);
  1184.                         pDebugWindow.Activate(true);
  1185.                         END;
  1186.                     pDebugView.RevealInsertionPoint;
  1187.                     END;    { NOT pWasActive }
  1188.                 END;        { FullHide }
  1189.             END;            { CASE }
  1190.         END;                { HideFromMacApp }
  1191.  
  1192.     PROCEDURE ShowToMacApp;
  1193.  
  1194.         BEGIN
  1195.         IF NOT oldpFullyHiddenFromMacapp THEN
  1196.             Case itsHideType OF
  1197.             RawHide:
  1198.                 ;    { Everyone has to do a miniShow (see below) }
  1199.  
  1200.             PartialHide:
  1201.                 BEGIN
  1202.                 ExchangeHandles(pSavedState.SaveVisRgn, GetSaveVisRgnPtr^);
  1203.                 SetEmptyRgn(pSavedState.SaveVisRgn);    { make sure the region stays empty }
  1204.                 ExchangeHandles(pSavedState.gTempRgn, gTempRgn);
  1205.                 gBusyTempRgn := pSavedState.gBusyTempRgn;
  1206.                 gUsedBy := pSavedState.gUsedBy;
  1207.  
  1208.                 SetFocus(pSavedState.pFocusRec);
  1209.  
  1210.                 IF DisciplineMethodCalls(oldpDisciplineMethodCalls) THEN;
  1211.                 IF PermAllocation(oldPerm) THEN;
  1212.  
  1213.                 gDebugPrinting := pSavedState.gDebugPrinting;
  1214.                 gIntenseDebugging := pSavedState.gIntenseDebugging;
  1215.                 pCanEnterDebugger := oldpCanEnterDebugger;
  1216.                 END;
  1217.  
  1218.             FullHide:
  1219.                 BEGIN
  1220.                 pDebugView.fHelpProc := @MainHelpProc;
  1221.                 pDebugWindow.fNextHandler := oldDebugWindowNextHandler;
  1222.  
  1223.                 IF (NOT pWasActive) & (NOT gSingleStep) & (pStepOverStackSize = 0) THEN
  1224.                     BEGIN
  1225.                     IF pWasFrontWindow <> NIL THEN
  1226.                         HiliteWindow(pWasFrontWindow, true);
  1227.                     HiliteWindow(pDebugWindow.fWMgrWindow, FALSE);
  1228.                     pDebugWindow.Activate(FALSE);
  1229.                     END
  1230.                 ELSE
  1231.                     pDebugWindow.fIsActive := pWasActive;
  1232.  
  1233.                 IF pWasAheadOfDebugWindow <> NIL THEN
  1234.                     BEGIN
  1235.                     SendBehind(pDebugWindow.fWMgrWindow, pWasAheadOfDebugWindow);
  1236.                     pDebugWindow.Update;
  1237.                     END;
  1238.  
  1239.                 SaveEventQueue(FALSE);
  1240.  
  1241.                 SetFocus(pSavedState.pFocusRec);
  1242.  
  1243.                 gBusyTempRgn := pSavedState.gBusyTempRgn;
  1244.                 gUsedBy := pSavedState.gUsedBy;
  1245.                 ExchangeHandles(pSavedState.gTempRgn, gTempRgn);
  1246.  
  1247.                 gDebugPrinting := pSavedState.gDebugPrinting;
  1248.                 gIntenseDebugging := pSavedState.gIntenseDebugging;
  1249.                 gApplication := pSavedState.gApplication;
  1250.                 gTarget := pSavedState.gTarget;
  1251.                 gClickCount := pSavedState.gClickCount;
  1252.                 gErrorParm3 := pSavedState.gErrorParm3;
  1253.                 gEventLevel := pSavedState.gEventLevel;
  1254.                 gIdlePhase := pSavedState.gIdlePhase;
  1255.                 gInBackground := pSavedState.gInBackground;
  1256.                 gLastClickPart := pSavedState.gLastClickPart;
  1257.                 gLastDeskAcc := pSavedState.gLastDeskAcc;
  1258.                 gLastMsePt := pSavedState.gLastMsePt;
  1259.                 gLastUpTime := pSavedState.gLastUpTime;
  1260.                 gMainEventMask := pSavedState.gMainEventMask;
  1261.  
  1262.                 ExchangeHandles(pSavedState.gCursorRgn, gCursorRgn);
  1263.                 ExchangeHandles(pSavedState.SaveVisRgn, GetSaveVisRgnPtr^);
  1264.  
  1265.                 IF DisciplineMethodCalls(pDisciplineMethodCalls) THEN;
  1266.                 pPermFlag := PermAllocation(pPermFlag);
  1267.                 pFullyHiddenFromMacapp := FALSE;
  1268.                 END;
  1269.             END;
  1270.         MiniShow;
  1271.         END;
  1272.  
  1273.     PROCEDURE HdlFailure(error: INTEGER;
  1274.                          message: Longint);
  1275.  
  1276.         BEGIN
  1277.         ShowToMacApp;
  1278.         pDebugView.EndForce;
  1279.         CallEnter(FALSE, pEnterProc);
  1280.         pCanEnterDebugger := true;
  1281.  
  1282.         END;
  1283.  
  1284.     BEGIN
  1285.     HideFromMacApp;
  1286.     if itsHideType <> RawHide THEN    { Stuff that's mini hidden isn't allowed to fail }
  1287.         CatchFailures(fi, HdlFailure);
  1288.  
  1289.     WhatToDo;
  1290.  
  1291.     if itsHideType <> RawHide THEN
  1292.         Success(fi);
  1293.     ShowToMacApp;
  1294.     END;
  1295.  
  1296. {--------------------------------------------------------------------------------------------------}
  1297. {$S MADebugger}
  1298.  
  1299. FUNCTION DebugReadCh: CHAR;
  1300.  
  1301.     VAR
  1302.         oldHelpProc:        ProcPtr;
  1303.  
  1304.     BEGIN
  1305.     oldHelpProc := pDebugView.fHelpProc;
  1306.     pDebugView.fHelpProc := NIL;
  1307.     REPEAT
  1308.         pDebugApplication.PollEvent(kAllowApplicationToSleep);
  1309.     UNTIL pDebugView.fLastCh <> CHR(0);
  1310.     DebugReadCh := pDebugView.fLastCh;
  1311.     pDebugView.fLastCh := CHR(0);
  1312.     pDebugView.fHelpProc := oldHelpProc;
  1313.     END;
  1314.  
  1315. {--------------------------------------------------------------------------------------------------}
  1316. {$S MADebugger}
  1317.  
  1318. FUNCTION DebugReadLn(buffer: Ptr;
  1319.                      byteCount: INTEGER): Longint;
  1320.  
  1321.     TYPE
  1322.         PA1000                = PACKED ARRAY [0..999] OF CHAR;
  1323.         StrPtr                = ^PA1000;
  1324.  
  1325.     VAR
  1326.         ch:                 CHAR;
  1327.         len:                INTEGER;
  1328.  
  1329.     PROCEDURE WhatToDo;
  1330.  
  1331.         BEGIN
  1332.         len := 0;
  1333.  
  1334.         REPEAT
  1335.             pDebugView.RevealInsertionPoint;
  1336.             ch := DebugReadCh;
  1337.  
  1338.             CASE ch OF
  1339.                 chBackspace:
  1340.                     IF len > 0 THEN
  1341.                         BEGIN
  1342.                         Write(ch);
  1343.                         len := len - 1;
  1344.                         StrPtr(buffer)^[len] := ' ';
  1345.                         END;
  1346.                 OTHERWISE
  1347.                     BEGIN
  1348.                     Write(ch);
  1349.                     StrPtr(buffer)^[len] := ch;
  1350.                     len := len + 1;
  1351.                     END
  1352.             END;
  1353.         UNTIL (ch = chReturn) | (len = byteCount);
  1354.  
  1355.         DebugReadLn := len;
  1356.         END;
  1357.  
  1358.     BEGIN
  1359.     IF FALSE & NOT pFullyHiddenFromMacapp THEN
  1360.         BEGIN
  1361.         which := tReadLn;
  1362.         IF gInBackground THEN
  1363.             InstallAnNMRequest;
  1364.         END;
  1365.     WithHideFromMacAppDo(WhatToDo, FullHide);
  1366.     END;
  1367.  
  1368. {--------------------------------------------------------------------------------------------------}
  1369. {$S MADebugger}
  1370.  
  1371. PROCEDURE InstallInterceptors(install: BOOLEAN);
  1372.  
  1373.     BEGIN
  1374.  
  1375.     IF install THEN
  1376.         BEGIN
  1377.         { Intercept 68000 exceptions }
  1378.         IF pInterceptExceptionVectors THEN
  1379.             BEGIN
  1380.             pOldexBusError := ProcPtrPtr(exBusError)^;
  1381.             ProcPtrPtr(exBusError)^ := @XDebugBusError;
  1382.  
  1383.             pOldexAddressError := ProcPtrPtr(exAddressError)^;
  1384.             ProcPtrPtr(exAddressError)^ := @XDebugAddrError;
  1385.  
  1386.             pOldexIllegalInst := ProcPtrPtr(exIllegalInst)^;
  1387.             ProcPtrPtr(exIllegalInst)^ := @XDebugIllInst;
  1388.  
  1389.             pOldexZeroDivide := ProcPtrPtr(exZeroDivide)^;
  1390.             ProcPtrPtr(exZeroDivide)^ := @XDebugZeroDiv;
  1391.  
  1392.             pOldexCheck := ProcPtrPtr(exCheck)^;
  1393.             ProcPtrPtr(exCheck)^ := @XDebugCheck;
  1394.  
  1395.             pOldexOverflow := ProcPtrPtr(exOverflow)^;
  1396.             ProcPtrPtr(exOverflow)^ := @XDebugOverflow;
  1397.  
  1398.             pOldexLineF := ProcPtrPtr(exLineF)^;
  1399.             ProcPtrPtr(exLineF)^ := @XDebugLineF;
  1400.             END;
  1401.  
  1402.         { Intercept SysError calls }
  1403.         FailOSErr(PatchTrap(pSysErrPatch, _SysError, @XDebugSysError));
  1404.         END
  1405.     ELSE
  1406.         BEGIN
  1407.         { UN-Intercept 68000 exceptions }
  1408.         IF pInterceptExceptionVectors THEN
  1409.             BEGIN
  1410.             IF ProcPtrPtr(exBusError)^ = @XDebugBusError THEN
  1411.                 ProcPtrPtr(exBusError)^ := pOldexBusError;
  1412.  
  1413.             IF ProcPtrPtr(exAddressError)^ = @XDebugAddrError THEN
  1414.                 ProcPtrPtr(exAddressError)^ := pOldexAddressError;
  1415.  
  1416.             IF ProcPtrPtr(exIllegalInst)^ = @XDebugIllInst THEN
  1417.                 ProcPtrPtr(exIllegalInst)^ := pOldexIllegalInst;
  1418.  
  1419.             IF ProcPtrPtr(exZeroDivide)^ = @XDebugZeroDiv THEN
  1420.                 ProcPtrPtr(exZeroDivide)^ := pOldexZeroDivide;
  1421.  
  1422.             IF ProcPtrPtr(exCheck)^ = @XDebugCheck THEN
  1423.                 ProcPtrPtr(exCheck)^ := pOldexCheck;
  1424.  
  1425.             IF ProcPtrPtr(exOverflow)^ = @XDebugOverflow THEN
  1426.                 ProcPtrPtr(exOverflow)^ := pOldexOverflow;
  1427.  
  1428.             IF ProcPtrPtr(exLineF)^ = @XDebugLineF THEN
  1429.                 ProcPtrPtr(exLineF)^ := pOldexLineF;
  1430.             END;
  1431.  
  1432.         { UN-Intercept SysError calls }
  1433.         UnpatchTrap(pSysErrPatch);
  1434.         END;
  1435.     END;
  1436.  
  1437. {--------------------------------------------------------------------------------------------------}
  1438. {$S MADebugger}
  1439.  
  1440. PROCEDURE JTOffProc(A5JTOffset: UNIV INTEGER;
  1441.                     VAR s: UNIV DisAsmStr80);
  1442.  
  1443.     CONST
  1444.         kUnloaded            = $3F3C;
  1445.  
  1446.     VAR
  1447.         aName:                MAName;
  1448.         pc:                 Longint;
  1449.  
  1450.     BEGIN
  1451.     pc := Longint(GetA5) + A5JTOffset;
  1452.     IF IntegerPtr(pc)^ <> kUnloaded THEN
  1453.         BEGIN
  1454.         GetMethodName(ord(@pc), aName);
  1455.         s := aName;
  1456.         END
  1457.     ELSE
  1458.         s := '';
  1459.     END;
  1460.  
  1461. {$EndC}
  1462.  
  1463. {--------------------------------------------------------------------------------------------------}
  1464. {$S MADebugger}
  1465.  
  1466. FUNCTION IsUserBreak: BOOLEAN;
  1467.  
  1468.     VAR
  1469.         aKeyMap:            KeyMap;
  1470.         oldState:            INTEGER;
  1471.  
  1472.     BEGIN
  1473.     oldState := IntegerPtr(JournalFlag)^;
  1474.     IntegerPtr(JournalFlag)^ := 0;                        { turn off journaling }
  1475.     GetKeys(aKeyMap);
  1476.     IntegerPtr(JournalFlag)^ := oldState;
  1477.     IsUserBreak := aKeyMap[55] & aKeyMap[56] & aKeyMap[58] & (NOT qDebug | pUDebugInitialized);
  1478.     END;
  1479.  
  1480. {$IFC qDebug}
  1481. {--------------------------------------------------------------------------------------------------}
  1482. {$S MADebugger}
  1483.  
  1484. PROCEDURE stdHelpProc;
  1485.  
  1486.     BEGIN
  1487.     WriteLn;
  1488.     WriteLn('Reply with one of the letters in the brackets');
  1489.     WriteLn;
  1490.     END;
  1491.  
  1492. {--------------------------------------------------------------------------------------------------}
  1493. {$S MADebugger}
  1494.  
  1495. FUNCTION GetPromptedChar(prompt: StringPtr;
  1496.                          validChars: StringPtr;
  1497.                          PROCEDURE helpProc): CHAR;
  1498.  
  1499.     VAR
  1500.         ch:                 CHAR;
  1501.         done:                BOOLEAN;
  1502.         index:                INTEGER;
  1503.  
  1504.     PROCEDURE WriteThePrompt;
  1505.  
  1506.         BEGIN
  1507.         Write(prompt^); Write(' ['); Write(validChars^); Write(kHelpRequest);
  1508.         Write(']: ');
  1509.         END;
  1510.  
  1511.     BEGIN
  1512.     WriteThePrompt;
  1513.     REPEAT
  1514.         pDebugView.RevealInsertionPoint;
  1515.         ch := UprChar(DebugReadCh);
  1516.         CASE ch OF
  1517.             kHelpRequest, chHelp:
  1518.                 BEGIN
  1519.                 helpProc;
  1520.                 WriteThePrompt;
  1521.                 done := FALSE
  1522.                 END;
  1523.             chReturn:
  1524.                 BEGIN
  1525.                 WriteLn;
  1526.                 done := true;
  1527.                 END;
  1528.             OTHERWISE
  1529.                 BEGIN
  1530.                 FOR index := 1 TO length(validChars^) DO
  1531.                     IF ch = UprChar(validChars^[index]) THEN
  1532.                         BEGIN
  1533.                         WriteLn(ch);
  1534.                         done := true;
  1535.                         LEAVE;
  1536.                         END;
  1537.                 IF index > length(validChars^) THEN
  1538.                     gApplication.Beep(30);                { 1/2 second }
  1539.                 END;
  1540.         END;
  1541.     UNTIL done;
  1542.     GetPromptedChar := ch;
  1543.     END;
  1544.  
  1545. {--------------------------------------------------------------------------------------------------}
  1546. {$S MADebugger}
  1547.  
  1548. FUNCTION GetPromptedString(prompt: StringPtr;
  1549.                            PROCEDURE helpProc): Str255;
  1550.  
  1551.     VAR
  1552.         returnStr:            Str255;
  1553.         done:                BOOLEAN;
  1554.  
  1555.     BEGIN
  1556.     Write(prompt^);
  1557.     returnStr := '';
  1558.     REPEAT
  1559.         pDebugView.RevealInsertionPoint;
  1560.         ch := DebugReadCh;
  1561.         CASE ch OF
  1562.             chHelp:
  1563.                 BEGIN
  1564.                 WriteLn;
  1565.                 helpProc;
  1566.                 Write(prompt^);
  1567.                 done := FALSE
  1568.                 END;
  1569.             chBackspace:
  1570.                 BEGIN
  1571.                 IF length(returnStr) > 0 THEN
  1572.                     BEGIN
  1573.                     Write(ch);
  1574.                     returnStr[0] := CHR(max(length(returnStr) - 1, 0));
  1575.                     END;
  1576.                 done := FALSE
  1577.                 END;
  1578.             chReturn:
  1579.                 BEGIN
  1580.                 Write(ch);
  1581.                 IF returnStr = kHelpRequest THEN
  1582.                     BEGIN
  1583.                     returnStr := '';
  1584.                     helpProc;
  1585.                     Write(prompt^);
  1586.                     done := FALSE
  1587.                     END
  1588.                 ELSE
  1589.                     done := true;
  1590.                 END;
  1591.             OTHERWISE
  1592.                 BEGIN
  1593.                 Write(ch);
  1594.                 returnStr := concat(returnStr, ch);
  1595.                 done := FALSE;
  1596.                 END;
  1597.         END;
  1598.     UNTIL done;
  1599.     GetPromptedString := returnStr;
  1600.     END;
  1601.  
  1602. {--------------------------------------------------------------------------------------------------}
  1603. {$S MADebugger}
  1604.  
  1605. FUNCTION GetFreeMastersCount: Longint;
  1606.  
  1607.     VAR
  1608.         zone:                THZ;
  1609.         pL:                 LongIntPtr;
  1610.         mpCnt:                Longint;
  1611.  
  1612.     BEGIN
  1613.     zone := ApplicZone;
  1614.     pL := LongIntPtr(zone^.hFstFree);
  1615.     mpCnt := 0;
  1616.     WHILE pL <> NIL DO
  1617.         BEGIN
  1618.         mpCnt := mpCnt + 1;
  1619.         pL := LongIntPtr(pL^);
  1620.         END;
  1621.     GetFreeMastersCount := mpCnt;
  1622.     END;
  1623.  
  1624. {--------------------------------------------------------------------------------------------------}
  1625. {$S MADebugger}
  1626.  
  1627. PROCEDURE CheckFreeMasters;
  1628.  
  1629.     VAR
  1630.         mp:                 Longint;
  1631.  
  1632.     BEGIN
  1633.     IF pMasters > 0 THEN                                { we computed # masters before }
  1634.         BEGIN
  1635.         mp := GetFreeMastersCount;
  1636.         IF pMasters <> mp THEN
  1637.             BEGIN
  1638.             WriteLn('pMasters: ', pMasters, '  current masters: ', mp);
  1639.             IF gMemMgtBreak THEN
  1640.                 gSingleStep := true;
  1641.             END;
  1642.         END;
  1643.  
  1644.     pMasters := GetFreeMastersCount
  1645.     END;
  1646.  
  1647. {--------------------------------------------------------------------------------------------------}
  1648. {$S MADebugger}
  1649.  
  1650. VAR
  1651.     aStaticString:        Str255;
  1652.  
  1653. PROCEDURE DebugWriteLn(textBuf: Ptr;
  1654.                        byteCount: INTEGER);
  1655.  
  1656.     VAR
  1657.         oldpCanEnterWriteLn: BOOLEAN;
  1658.  
  1659.     PROCEDURE WhatToDo;
  1660.  
  1661.         BEGIN
  1662.         IF fCaptureProc <> NIL THEN
  1663.             CallCapture(textBuf, byteCount, fCaptureProc);
  1664.  
  1665.         IF pDebugView <> NIL THEN
  1666.             pDebugView.AddText(textBuf, byteCount)        { send it to the current transcript window }
  1667.         END;
  1668.  
  1669.     BEGIN
  1670.     oldpCanEnterWriteLn := pCanEnterWriteLn;
  1671.     pCanEnterWriteLn := FALSE;
  1672.  
  1673.     IF NOT oldpCanEnterWriteLn THEN                     { Not re-entrant but at least give user a
  1674.                                                          fighting chance }
  1675.         BEGIN
  1676.         aStaticString[0] := CHR(Min(255, byteCount));
  1677.         BlockMove(textBuf, @aStaticString[1], length(aStaticString));
  1678.         DebugStr(concat('Re-entering DebugWriteLn: ', aStaticString));
  1679.         END;
  1680.  
  1681.     WithHideFromMacAppDo(WhatToDo, PartialHide);
  1682.       pCanEnterWriteLn := oldpCanEnterWriteLn;
  1683.  
  1684.     END;
  1685.  
  1686. {--------------------------------------------------------------------------------------------------}
  1687. {$S MADebugger}
  1688.  
  1689. PROCEDURE InstallWriteLnHook;
  1690.  
  1691.     CONST
  1692.         kConsoleName        = 'Dev:Console';
  1693.         _CODEV                = 1;                        { console device number }
  1694.  
  1695.     VAR
  1696.         slot:                Longint;
  1697.         oldProc:            ProcPtr;
  1698.  
  1699.     BEGIN
  1700.     pFileName := kConsoleName;
  1701.     slot := _addDevHandler(_CODEV, 0, ord(@DevFAccess), ord(@DevClose), ord(@DevRead),
  1702.                            ord(@DevWrite), ord(@DevIoctl));
  1703.     PLsetvbuf(output, NIL, _IOLBF, 128);
  1704.     oldProc := SetGetProc(@DebugReadLn);
  1705.     oldProc := SetPutProc(@DebugWriteLn);
  1706.     END;
  1707.  
  1708. {--------------------------------------------------------------------------------------------------}
  1709. {$S MAInit}
  1710.  
  1711. PROCEDURE InitUDebug(segTable, nonRes: Handle;
  1712.                      enterProc, inspectProc, symbolProc: Ptr);
  1713. { essential initialization (segTable, nonRes left in for compatibility (2.0) }
  1714.  
  1715.     CONST
  1716.         kDebugHeight        = 100;
  1717.         kVMargin            = 4;
  1718.         kHMargin            = 4;
  1719.  
  1720.     TYPE
  1721.         dbugParams            = RECORD                    { Format of 'dbug' resource }
  1722.             boundsRect:         Rect;                    { Rect of debugging window }
  1723.             fontNumber:         INTEGER;                { Font rsrc ID }
  1724.             fontSize:            INTEGER;                { Font size }
  1725.             numLines:            INTEGER;                { Number of lines }
  1726.             lineWidth:            INTEGER;                { Line width }
  1727.             openInitially:        BOOLEAN;                { Open Initially }
  1728.             title:                Str255;                 { Actually, variable length }
  1729.             END;
  1730.         dbugParamsPtr        = ^dbugParams;
  1731.         dbugParamsHandle    = ^dbugParamsPtr;
  1732.  
  1733.     VAR
  1734.         aTranscriptView:    TTranscriptView;
  1735.         wasAddNewObjectsToInspector: BOOLEAN;
  1736.         wasTrcEnable:        BOOLEAN;
  1737.         dParams:            Handle;
  1738.  
  1739.         addr:                Longint;
  1740.         i:                    INTEGER;
  1741.         err:                OSErr;
  1742.         vhs:                VHSelect;
  1743.         zoomedOutSize:        Point;
  1744.         aDebugParams:        dbugParams;
  1745.         aTextStyle:         TextStyle;
  1746.         Errs:                Handle;
  1747.  
  1748.     BEGIN
  1749.     pCanEnterWriteLn := true;
  1750.     pMadeNMRequest := FALSE;
  1751.     IF YouAreWarned THEN                                { for testing }
  1752.         pInterceptExceptionVectors := FALSE
  1753.     ELSE
  1754.         pInterceptExceptionVectors := true;
  1755.  
  1756.     {$IFC NOT qDebugTheDebugger}
  1757.     wasAddNewObjectsToInspector := AddNewObjectsToInspector(FALSE);
  1758.     {$ENDC}
  1759.  
  1760.     New(pDebugApplication);
  1761.  
  1762.     {$IFC NOT qDebugTheDebugger}
  1763.     IF AddNewObjectsToInspector(wasAddNewObjectsToInspector) THEN;
  1764.     {$ENDC}
  1765.  
  1766.     FailNil(pDebugApplication);
  1767.     pDebugApplication.IDebugApplication;
  1768.  
  1769.     { T R I C K   N O T E }
  1770.     { This will allow debugger window operations (resizing, etc.) that require a gApplication
  1771.     to succeed before the real application is available.  When the real application's IApplication
  1772.     method is called the global: gApplication will be replaced with a reference to it. }
  1773.     gApplication := pDebugApplication;
  1774.     gTarget := pDebugApplication;
  1775.  
  1776.     pSavedState.SaveVisRgn := NIL;
  1777.     pSavedState.SaveVisRgn := MakeNewRgn;
  1778.     FailNil(pSavedState.SaveVisRgn);
  1779.  
  1780.     pSavedState.gCursorRgn := NIL;
  1781.     pSavedState.gCursorRgn := MakeNewRgn;
  1782.     FailNil(pSavedState.gCursorRgn);
  1783.  
  1784.     pTP2PerfGlobals := NIL;
  1785.  
  1786.     pTraceToggle := FALSE;
  1787.     gSingleStep := FALSE;
  1788.     pBreakCount := 0;
  1789.     pTraceEnabled := FALSE;
  1790.     gTracing := FALSE;
  1791.     gReportNext := FALSE;
  1792.     gReportInfo := '';
  1793.     gReportTime := FALSE;
  1794.     pQuietOutput := FALSE;
  1795.  
  1796.     pMasters := - 1;
  1797.  
  1798.     pFlagsInUse := 0;
  1799.     pSymsInUse := 0;
  1800.  
  1801.     gMaxStackDepth := - 1;
  1802.     pBreakStack := $7FFFFFFF;
  1803.     pStepOverStackSize := 0;
  1804.     pBrProcStack := $7FFFFFFF;
  1805.     gMaxLockedRsrc := 0;
  1806.  
  1807.     pAddTextFocusRec.Clip := NIL;
  1808.     pAddTextFocusRec.Clip := MakeNewRgn;
  1809.     pAddTextFocusRec.FocusedView := NIL;
  1810.     pAddTextFocusRec.Org := gZeroPt;
  1811.     pAddTextFocusRec.LongOffset := gZeroVPt;
  1812.     pAddTextFocusRec.Port := gWorkPort;
  1813.     pAddTextFocusRec.printing := FALSE;
  1814.     pAddTextFocusRec.drawingPictScrap := FALSE;
  1815.  
  1816.     pSavedState.pFocusRec.Clip := NIL;
  1817.     pSavedState.pFocusRec.Clip := MakeNewRgn;
  1818.  
  1819.     pSavedState.gBusyTempRgn := FALSE;
  1820.     pSavedState.gUsedBy := '';
  1821.     pSavedState.gTempRgn := NIL;
  1822.     pSavedState.gTempRgn := MakeNewRgn;
  1823.     pDisciplineMethodCalls := true;                     { matches default in uobject }
  1824.  
  1825.     pFullyHiddenFromMacapp := FALSE;
  1826.  
  1827.     pEnterProc := enterProc;
  1828.     pInspectProc := inspectProc;
  1829.     pSymbolProc := symbolProc;
  1830.  
  1831.     FOR i := 0 TO kRecent DO
  1832.         BEGIN
  1833.         pRecentPC[i].thePC := 0;
  1834.         pRecentPC[i].theZT := tSysError;
  1835.         END;
  1836.     pRecentIndex := 0;
  1837.  
  1838.     fCaptureProc := NIL;
  1839.     pReserve := NewPermHandle(kReserve);                { Reserve some space in case of SysErr }
  1840.     FailNil(pReserve);
  1841.  
  1842.     InstallInterceptors(true);
  1843.  
  1844.     {$IFC NOT qDebugTheDebugger}
  1845.     wasAddNewObjectsToInspector := AddNewObjectsToInspector(FALSE);
  1846.     {$ENDC}
  1847.  
  1848.     dParams := GetResource('dbug', kDebugParamsID);
  1849.     IF dParams <> NIL THEN
  1850.         BEGIN
  1851.         aDebugParams := dbugParamsHandle(dParams)^^;
  1852.         ReleaseResource(dParams);                        { asta la vista }
  1853.         WITH aDebugParams DO
  1854.             BEGIN
  1855.             IF EqualRect(boundsRect, gZeroRect) THEN
  1856.                 BEGIN
  1857.                 boundsRect := screenbits.bounds;
  1858.                 InsetRect(boundsRect, 5, 5);
  1859.                 boundsRect.top := boundsRect.bottom - kDebugHeight;
  1860.                 END
  1861.             END
  1862.         END
  1863.     ELSE
  1864.         WITH aDebugParams DO
  1865.             BEGIN
  1866.             boundsRect := screenbits.bounds;
  1867.             InsetRect(boundsRect, 5, 5);
  1868.             boundsRect.top := boundsRect.bottom - kDebugHeight;
  1869.  
  1870.             fontNumber := kDebugFont;
  1871.             fontSize := kDebugSize;
  1872.             numLines := 120;
  1873.             lineWidth := 100;
  1874.             openInitially := FALSE;
  1875.             title := '';
  1876.             END;
  1877.  
  1878.     IF qTemplateViews THEN
  1879.         BEGIN
  1880.         pDebugWindow := NewTemplateWindow(kDebugWindowType, NIL);
  1881.         pDebugView := TTranscriptView(pDebugWindow.FindSubView('trns'));
  1882.         END
  1883.     ELSE
  1884.         BEGIN
  1885.         New(aTranscriptView);
  1886.         FailNil(aTranscriptView);
  1887.         WITH aDebugParams DO
  1888.             aTranscriptView.ITranscriptView(NIL, fontNumber, fontSize, numLines, lineWidth);
  1889.  
  1890.         pDebugView := aTranscriptView;
  1891.  
  1892.         pDebugWindow := NewSimpleWindow(kDebugWindowType, kWantHScrollBar, kWantVScrollBar, NIL,
  1893.                                         pDebugView);
  1894.  
  1895.         END;
  1896.  
  1897.     pDebugView.fHelpProc := @MainHelpProc;
  1898.     WITH aDebugParams DO
  1899.         BEGIN
  1900.         IF title <> '' THEN
  1901.             pDebugWindow.SetTitle(title);
  1902.         pDebugWindow.Locate(boundsRect.left, boundsRect.top, kDontInvalidate);
  1903.         pDebugWindow.Resize(MinMax(kSBarSize * 4, boundsRect.right - boundsRect.left,
  1904.                                    max(pDebugView.fSize.h + kSBarSize, boundsRect.right -
  1905.                                    boundsRect.left)), MinMax(kSBarSize * 4, boundsRect.bottom -
  1906.                                                              boundsRect.top,
  1907.                                                              max(pDebugView.fSize.v + kSBarSize,
  1908.                                                              boundsRect.bottom - boundsRect.top)),
  1909.                             kDontInvalidate);
  1910.         SetTextStyle(aTextStyle, fontNumber, [], fontSize, gRGBBlack);
  1911.         pDebugView.InstallTextStyle(aTextStyle);
  1912.         {$Push} {$H-}
  1913.         zoomedOutSize := VPtToPt(pDebugView.fSize);
  1914.         {$Pop}
  1915.         WITH zoomedOutSize DO
  1916.             BEGIN
  1917.             v := (2 * kVMargin) + (pDebugView.fFontHeight * (pDebugView.fRows));
  1918.             v := max(kSBarSize * 4, v + kSBarSize);
  1919.             h := max(kSBarSize * 4, h + kSBarSize);
  1920.             END;
  1921.  
  1922.         pDebugWindow.SetResizeLimits(gStdWSizeRect.topLeft, zoomedOutSize);
  1923.         pDebugWindow.ForceOnScreen;
  1924.         IF openInitially THEN
  1925.             pDebugWindow.Open;
  1926.         pDebugWindow.Update;
  1927.         END;
  1928.  
  1929.     gApplication.DeleteFreeWindow(pDebugWindow);        { so we don't show }
  1930.  
  1931.     {$IFC NOT qDebugTheDebugger}
  1932.     IF AddNewObjectsToInspector(wasAddNewObjectsToInspector) THEN;
  1933.     {$ENDC}
  1934.  
  1935.     {$IFC IncludeDisassembler}
  1936.     { Init Ira's disassembler }
  1937.     InitLookup(NIL, @JTOffProc, @LookupTrapName, NIL, NIL);
  1938.     {$EndC}
  1939.  
  1940.     VBLInstall;
  1941.  
  1942.     DebugGlobalHandle(@pSavedState.gTarget, NIL, AtMAName('gTarget'));
  1943.     DebugGlobalHandle(@pSavedState.gApplication, NIL, AtMAName('gApplication'));
  1944.     DebugGlobalHandle(@gDocList, NIL, AtMAName('gDocList'));
  1945.     DebugGlobalHandle(@gFreeWindowList, NIL, AtMAName('gFreeWindowList'));
  1946.     DebugGlobalHandle(@gClipView, NIL, AtMAName('gClipView'));
  1947.     DebugGlobalHandle(@gClipUndoView, NIL, AtMAName('gClipUndoView'));
  1948.     DebugGlobalHandle(@gPrintHandler, NIL, AtMAName('gPrintHandler'));
  1949.     DebugGlobalHandle(@pSavedState.pFocusRec.FocusedView, NIL, AtMAName('gFocusedView'));
  1950.  
  1951.     DebugGlobalHandle(NIL, @DebugGetLastCommand, AtMAName('GetLastCommand'));
  1952.     DebugGlobalHandle(NIL, @DebugGetActiveWindow, AtMAName('GetActiveWindow'));
  1953.     DebugGlobalHandle(NIL, @DebugGetActiveDocument, AtMAName('GetActiveDocument'));
  1954.  
  1955.     DebugFlag(@pSavedState.gIntenseDebugging, 'I', NIL, AtStr('Intense debugging'));
  1956.     DebugFlag(@gMemMgtBreak, 'B', NIL, AtStr('Memory management break'));
  1957.     DebugFlag(@gMastReport, 'M', NIL, AtStr('Report # masters'));
  1958.     DebugFlag(@gSegReport, 'S', NIL, AtStr('Report segment load'));
  1959.     DebugFlag(@gUnloadAllSegs, 'U', NIL, AtStr('Unload segments'));
  1960.     DebugFlag(@gExperimenting, 'X', NIL, AtStr('Experimenting'));
  1961.     DebugFlag(@gAskFailure, 'F', NIL, AtStr('Ask about failures'));
  1962.     DebugFlag(@gReportEvt, 'E', NIL, AtStr('Report events'));
  1963.     DebugFlag(@gAskAboutAlloc, 'A', NIL, AtStr('Ask about allocations'));
  1964.     DebugFlag(@gRsrcReport, 'R', NIL, AtStr('Report resource usage'));
  1965.     DebugFlag(@gReportMenuChoices, 'C', NIL, AtStr('Report menu commands'));
  1966.     DebugFlag(@pSavedState.gDebugPrinting, 'P', NIL, AtStr('Printing debug'));
  1967.     DebugFlag(@pDisciplineMethodCalls, 'D', @DisciplineMethodCalls,
  1968.               AtStr('Discipline method calls'));
  1969.     DebugFlag(@gAssumeFocused, 'V', NIL, AtStr('Do "AssumeFocused" preconditioning'));
  1970.  
  1971.     {$IFC qExperimentalAndUnsupported}
  1972.     DebugFlag(@gEnableDoubleBuffering, 'G', NIL, AtStr('Enable double buffering of views'));
  1973.     {$EndC}
  1974.  
  1975.     { Make sure the error strings are always available by loading them and but not
  1976.     letting them be purgeable }
  1977.     Errs := GetResource('STR#', 252);
  1978.     FailNILResource(Errs);
  1979.     HNoPurge(Errs);
  1980.  
  1981.     IF qTemplateViews THEN
  1982.         BEGIN
  1983.         { Suppress Linker dead stripping of these }
  1984.         IF gDeadStripSuppression THEN
  1985.             IF Member(TObject(NIL), TTranscriptView) THEN;
  1986.         END;
  1987.  
  1988.     { LAST THING ON INIT: install the console interceptor }
  1989.     InstallWriteLnHook;
  1990.  
  1991.     pUDebugInitialized := true;
  1992.     pCanEnterDebugger := true;
  1993.  
  1994.     END;
  1995.  
  1996. {--------------------------------------------------------------------------------------------------}
  1997. {$S MADebugger}
  1998.  
  1999. PROCEDURE DebugTerminate;
  2000.  
  2001.     BEGIN
  2002.     IF pUDebugInitialized THEN
  2003.         BEGIN
  2004.         VBLRemove;
  2005.  
  2006.         IF DebugRedirect(0, NIL) <> noErr THEN;         { (discard result) close redirect file }
  2007.  
  2008.         {$IFC qPerform}
  2009.         { Make sure the performance tools are shut down if they are initialized }
  2010.         IF pTP2PerfGlobals <> NIL THEN
  2011.             BEGIN
  2012.             TermPerf(pTP2PerfGlobals);
  2013.             pTP2PerfGlobals := NIL;
  2014.             END;
  2015.         {$ENDC}
  2016.  
  2017.         InstallInterceptors(FALSE);
  2018.  
  2019.         { Guarantee we can't be re-entered }
  2020.         pUDebugInitialized := FALSE;
  2021.         pCanEnterDebugger := FALSE;
  2022.  
  2023.         END;
  2024.     END;
  2025. {--------------------------------------------------------------------------------------------------}
  2026. {$S MADebugger}
  2027.  
  2028. PROCEDURE DebugFlag(flagAddr: BooleanPtr;
  2029.                     flagChar: CHAR;
  2030.                     theActionProc: ProcPtr;             {CONST}
  2031.                     flagDesc: StringPtr);
  2032. { Register a BOOLEAN flag for the X debugger command;
  2033. flagAddr should be the address of the flag;
  2034. theActionProc should be a procPtr for a proc to be called to change the flag (optional).
  2035. flagChar should be the character to use in the debugger to toggle the flag;
  2036. desc should be a short description of the flag.
  2037. No checking is done for duplicate flagChars. }
  2038.  
  2039.     BEGIN
  2040.     IF pFlagsInUse < kMaxFlags THEN
  2041.         BEGIN
  2042.         pFlagsInUse := pFlagsInUse + 1;
  2043.         WITH pFlagTable[pFlagsInUse] DO
  2044.             BEGIN
  2045.             addr := flagAddr;
  2046.             ch := UprChar(flagChar);
  2047.             actionProc := theActionProc;
  2048.             desc := NewString(flagDesc^);
  2049.             FailNil(desc);
  2050.             END;
  2051.         END;
  2052.     END;
  2053.  
  2054. {--------------------------------------------------------------------------------------------------}
  2055. {$S MADebugger}
  2056.  
  2057. PROCEDURE DebugGlobalHandle(globAddr: Ptr;
  2058.                             theActionProc: ProcPtr;     {CONST}
  2059.                             globSym: MANamePtr);
  2060. { Register a symbol name of a global variable that contains a handle;
  2061. Case does not matter.  The global variable should contain a Handle.
  2062. The Action proc is a Function to be called to derive the handle if necessary. }
  2063.  
  2064.     BEGIN
  2065.     IF pSymsInUse < kMaxSyms THEN
  2066.         BEGIN
  2067.         pSymsInUse := pSymsInUse + 1;
  2068.         WITH pSymTable[pSymsInUse] DO
  2069.             BEGIN
  2070.             addr := globAddr;
  2071.             actionProc := theActionProc;
  2072.             sym := globSym^;
  2073.  
  2074.             END;
  2075.         END;
  2076.     END;
  2077.  
  2078. {--------------------------------------------------------------------------------------------------}
  2079. {$S MADebugger}
  2080.  
  2081. FUNCTION GetPromptedNames(prompt: StringPtr;
  2082.                           VAR className, procName: MAName): BOOLEAN;
  2083.  
  2084.     VAR
  2085.         ch:                 CHAR;
  2086.         len:                INTEGER;
  2087.         s:                    Str255;
  2088.         i:                    INTEGER;
  2089.  
  2090.     PROCEDURE helpProc;
  2091.  
  2092.         BEGIN
  2093.         WriteLn;
  2094.         WriteLn('Please supply a ClassName.MethodName or MethodName or ProcName');
  2095.         WriteLn;
  2096.         END;
  2097.  
  2098.     BEGIN
  2099.     GetPromptedNames := FALSE;
  2100.  
  2101.     className := '';
  2102.     procName := '';
  2103.     len := 0;
  2104.  
  2105.     s := GetPromptedString(prompt, helpProc);
  2106.  
  2107.     FOR i := 1 TO length(s) DO
  2108.         BEGIN
  2109.         ch := UprChar(s[i]);
  2110.  
  2111.         IF ch IN ['A'..'Z', '0'..'9', '_', '%'] THEN
  2112.             BEGIN
  2113.             GetPromptedNames := true;
  2114.             len := len + 1;
  2115.             procName[len] := ch;
  2116.             procName[0] := CHR(len);
  2117.             END
  2118.         ELSE IF ch = '.' THEN
  2119.             BEGIN
  2120.             className := procName;
  2121.             procName := '';
  2122.             len := 0;
  2123.             END
  2124.         ELSE IF ch <> ' ' THEN
  2125.             BEGIN
  2126.             GetPromptedNames := FALSE;
  2127.             WriteLn(kDontKnow);
  2128.             Exit(GetPromptedNames);
  2129.             END;
  2130.         END;
  2131.     END;
  2132.  
  2133. {--------------------------------------------------------------------------------------------------}
  2134. {$S MADebugger}
  2135.  
  2136. FUNCTION GetPromptedValue(prompt: StringPtr;
  2137.                           VAR asDecimal, asHex: Longint;
  2138.                           symbolOK: BOOLEAN;
  2139.                           VAR gotSymbol: BOOLEAN): BOOLEAN;
  2140.  { returns TRUE iff a valid number is typed;
  2141.   if it returns FALSE but the parameters are 0, then the user typed only a return;
  2142.  
  2143.   if symbolOK is TRUE then a symbol is allowed, and gotSymbol will indicate if
  2144.   a symbol was typed }
  2145.  
  2146.     VAR
  2147.         ch:                 CHAR;
  2148.         digit:                INTEGER;
  2149.         anEvent:            EventRecord;
  2150.         s:                    Str255;
  2151.         i:                    INTEGER;
  2152.         sym:                Str255;
  2153.         done:                BOOLEAN;
  2154.         symbolTableSym:     Str255;
  2155.         gotNegation:        BOOLEAN;
  2156.  
  2157.     PROCEDURE helpProc;
  2158.  
  2159.         VAR
  2160.             i:                    INTEGER;
  2161.  
  2162.         BEGIN
  2163.         WriteLn;
  2164.         Write('Please supply a valid number');
  2165.         IF NOT symbolOK THEN
  2166.             WriteLn('.')
  2167.         ELSE
  2168.             BEGIN
  2169.             Write(' or one of the following symbols:');
  2170.             sym := kHelpRequest;
  2171.             asDecimal := CallSymbolLookup(sym, pSymbolProc);
  2172.             WriteLn;
  2173.  
  2174.             FOR i := 1 TO pSymsInUse DO
  2175.                 Write(pSymTable[i].sym, ' ');
  2176.             WriteLn;
  2177.             END;
  2178.         END;
  2179.  
  2180.     BEGIN
  2181.     asDecimal := 0;
  2182.     asHex := 0;
  2183.     gotSymbol := FALSE;
  2184.  
  2185.     s := GetPromptedString(prompt, helpProc);
  2186.     UprString(s, FALSE);
  2187.  
  2188.     IF s = '' THEN
  2189.         GetPromptedValue := FALSE
  2190.     ELSE
  2191.         BEGIN
  2192.         GetPromptedValue := true;
  2193.  
  2194.         IF symbolOK & ((s[1] = '''') | NOT (s[1] IN ['-', '0'..'9', 'A'..'F'])) THEN
  2195.             BEGIN
  2196.             gotSymbol := true;
  2197.  
  2198.             IF s[1] = '''' THEN
  2199.                 Delete(s, 1, 1);
  2200.  
  2201.             sym := s;
  2202.  
  2203.             asDecimal := CallSymbolLookup(sym, pSymbolProc);
  2204.  
  2205.             IF asDecimal = - 1 THEN                     { search local symbol table }
  2206.                 BEGIN
  2207.                 i := 1;
  2208.                 symbolTableSym := pSymTable[i].sym;
  2209.                 UprStr255(symbolTableSym);
  2210.                 WHILE (i <= pSymsInUse) & (symbolTableSym <> sym) DO
  2211.                     BEGIN
  2212.                     i := i + 1;
  2213.                     IF (i <= pSymsInUse) THEN
  2214.                         BEGIN
  2215.                         symbolTableSym := pSymTable[i].sym;
  2216.                         UprStr255(symbolTableSym);
  2217.                         END;
  2218.                     END;
  2219.  
  2220.                 IF i <= pSymsInUse THEN
  2221.                     BEGIN
  2222.                     IF pSymTable[i].addr = NIL THEN
  2223.                         asDecimal := Longint(CallSymActionProc(pSymTable[i].actionProc))
  2224.                     ELSE
  2225.                         asDecimal := LongIntPtr(pSymTable[i].addr)^;
  2226.                     END;
  2227.                 END;
  2228.             asHex := asDecimal;
  2229.  
  2230.             IF asHex = - 1 THEN
  2231.                 BEGIN
  2232.                 WriteLn(kDontKnow);
  2233.                 GetPromptedValue := FALSE;
  2234.                 END;
  2235.             END
  2236.         ELSE
  2237.             BEGIN
  2238.             gotNegation := FALSE;
  2239.             FOR i := 1 TO length(s) DO
  2240.                 BEGIN
  2241.                 ch := s[i];
  2242.  
  2243.                 digit := - 1;
  2244.                 IF ch IN ['0'..'9'] THEN
  2245.                     digit := ord(ch) - ord('0')
  2246.                 ELSE IF ch IN ['-'] THEN
  2247.                     gotNegation := true
  2248.                 ELSE IF ch IN ['A'..'F'] THEN
  2249.                     BEGIN
  2250.                     digit := 10 + ord(ch) - ord('A');
  2251.                     asDecimal := - 1;
  2252.                     END
  2253.                 ELSE
  2254.                     BEGIN
  2255.                     asDecimal := - 1;
  2256.                     asHex := - 1;
  2257.                     WriteLn(kDontKnow);
  2258.                     GetPromptedValue := FALSE;
  2259.                     Exit(GetPromptedValue)
  2260.                     END;
  2261.  
  2262.                 IF digit >= 0 THEN
  2263.                     BEGIN
  2264.                     IF asDecimal >= 0 THEN
  2265.                         asDecimal := 10 * asDecimal + digit;
  2266.                     IF asHex >= 0 THEN
  2267.                         asHex := 16 * asHex + digit;
  2268.                     END;
  2269.                 END;
  2270.             IF gotNegation THEN
  2271.                 BEGIN
  2272.                 IF (asDecimal >= 0) THEN
  2273.                     asDecimal := - asDecimal;
  2274.                 IF asHex >= 0 THEN
  2275.                     asHex := - asHex;
  2276.                 END;
  2277.             END;
  2278.         END;
  2279.     END;
  2280.  
  2281. {--------------------------------------------------------------------------------------------------}
  2282. {$S MADebugger}
  2283.  
  2284. FUNCTION GetPromptedNumber(prompt: StringPtr;
  2285.                            VAR asDecimal, asHex: Longint): BOOLEAN; { returns TRUE iff a valid
  2286.                                                                      number is typed; if it returns
  2287.                                                                      FALSE but the parameters are
  2288.                                                                      0, then the user typed only a
  2289.                                                                      return }
  2290.  
  2291.     VAR
  2292.         symbol:             BOOLEAN;
  2293.  
  2294.     BEGIN
  2295.     GetPromptedNumber := GetPromptedValue(prompt, asDecimal, asHex, FALSE, symbol);
  2296.     END;
  2297.  
  2298. {--------------------------------------------------------------------------------------------------}
  2299. {$S MADebugger}
  2300.  
  2301. FUNCTION GetPromptedNumberWithDefault(prompt: StringPtr;
  2302.                                       default: INTEGER): INTEGER;
  2303. { Returns a number typed by the user.  Returns the default if a return is typed. }
  2304.  
  2305.     VAR
  2306.         s:                    Str255;
  2307.  
  2308.     BEGIN
  2309.     s := concat(ConcatNumber(concat(prompt^, ' [default = '), default), ']?:');
  2310.     IF GetPromptedNumber(@s, asDecimal, asHex) THEN
  2311.         GetPromptedNumberWithDefault := asDecimal
  2312.     ELSE
  2313.         GetPromptedNumberWithDefault := default;
  2314.     END;
  2315.  
  2316. {--------------------------------------------------------------------------------------------------}
  2317. {$S MADebugger}
  2318.  
  2319. FUNCTION GetPromptedStringWithDefault(prompt: StringPtr;
  2320.                                       default: StringPtr;
  2321.                                       PROCEDURE helpProc): Str255;
  2322. { Returns a string typed by the user.  Returns the default if a return is typed. }
  2323.  
  2324.     VAR
  2325.         s:                    Str255;
  2326.  
  2327.     BEGIN
  2328.     s := concat(prompt^, ' [default = ', default^, ']?:');
  2329.     s := GetPromptedString(@s, helpProc);
  2330.     IF s <> '' THEN
  2331.         GetPromptedStringWithDefault := s
  2332.     ELSE
  2333.         GetPromptedStringWithDefault := default^;
  2334.     END;
  2335.  
  2336. {--------------------------------------------------------------------------------------------------}
  2337. {$S MADebugger}
  2338. {$IFC IncludeDisassembler}
  2339. PROCEDURE ShowDisasmMemory(startAddress, numBytes: Longint);
  2340.  
  2341.     VAR
  2342.         idx:                INTEGER;
  2343.         BytesUsed:            INTEGER;
  2344.         opCode, Operand, Comment: DisAsmStr80;
  2345.  
  2346.     BEGIN
  2347.     WHILE numBytes > 0 DO
  2348.         BEGIN
  2349.         Disassembler(0, BytesUsed, startAddress, opCode, Operand, Comment, @Lookup);
  2350.         Write('    ');
  2351.         WritePtr(startAddress);
  2352.         Write(':  '); WriteLn(opCode, ' ', Operand, ' ', Comment);
  2353.         numBytes := numBytes - BytesUsed;
  2354.         startAddress := startAddress + BytesUsed;
  2355.         END;
  2356.     pMoreMem := startAddress;
  2357.     END;
  2358. {$EndC}
  2359.  
  2360. {$EndC}
  2361.  
  2362. {--------------------------------------------------------------------------------------------------}
  2363. {$S MADebugger}
  2364.  
  2365. PROCEDURE ShowMemory(startAddress, numBytes: Longint);
  2366.  
  2367.     VAR
  2368.         i:                    INTEGER;
  2369.         addr:                Longint;
  2370.         lines:                INTEGER;
  2371.         numeric:            STRING[40];
  2372.         ascii:                STRING[16];
  2373.         numPos:             INTEGER;
  2374.         ascPos:             INTEGER;
  2375.         decNumber:            Longint;
  2376.         chCode:             INTEGER;
  2377.         j:                    INTEGER;
  2378.  
  2379. {--------------------------------------------------------------------------------------------------}
  2380.  
  2381.     PROCEDURE BlankLine;
  2382.  
  2383.         CONST
  2384.             k8Spaces            = '        ';
  2385.  
  2386.         BEGIN
  2387.         ascii := concat(k8Spaces, k8Spaces);
  2388.         numeric := concat(ascii, ascii, k8Spaces);
  2389.         numPos := 0;
  2390.         ascPos := 0;
  2391.         END;
  2392.  
  2393. {--------------------------------------------------------------------------------------------------}
  2394.  
  2395.     PROCEDURE PrintLine;
  2396.  
  2397.         BEGIN
  2398.         WriteLn(numeric, '  ', ascii);
  2399.         END;
  2400.  
  2401.     BEGIN
  2402.     IF Odd(startAddress) THEN
  2403.         WriteLn('Odd Address')
  2404.     ELSE IF numBytes > 0 THEN
  2405.         BEGIN
  2406.         BlankLine;
  2407.  
  2408.         FOR i := 0 TO (numBytes - 1) DIV 2 DO
  2409.             BEGIN
  2410.             lines := 0;
  2411.             addr := startAddress + i + i;
  2412.  
  2413.             IF (i MOD 8) = 0 THEN
  2414.                 BEGIN
  2415.                 IF i > 0 THEN
  2416.                     BEGIN
  2417.                     PrintLine;
  2418.                     BlankLine;
  2419.                     lines := lines + 1;
  2420.                     END;
  2421.                 IF IsUserBreak | (lines > 20) THEN
  2422.                     BEGIN
  2423.                     WriteLn('More… [M]: ');
  2424.                     Exit(ShowMemory);
  2425.                     END;
  2426.                 Write('    ');
  2427.                 WritePtr(addr);
  2428.                 Write(':  ');
  2429.                 END;
  2430.  
  2431.             decNumber := IntegerPtr(addr)^;
  2432.             FOR j := 4 DOWNTO 1 DO
  2433.                 BEGIN
  2434.                 numeric[numPos + j] := kHexDigits[BAND(decNumber, 15) + 1];
  2435.                 decNumber := BSR(decNumber, 4);
  2436.                 END;
  2437.  
  2438.             decNumber := IntegerPtr(addr)^;
  2439.             FOR j := 2 DOWNTO 1 DO
  2440.                 BEGIN
  2441.                 chCode := BAND(decNumber, 255);
  2442.                 IF (chCode < $20) | (chCode > $D8) | (chCode = $7F) THEN { control, unassigned, or
  2443.                                                                           DEL }
  2444.                     chCode := ord('•');
  2445.                 ascii[ascPos + j] := CHR(chCode);
  2446.                 decNumber := BSR(decNumber, 8);
  2447.                 END;
  2448.  
  2449.             numPos := numPos + 5;
  2450.             ascPos := ascPos + 2;
  2451.  
  2452.             pMoreMem := addr + 2;
  2453.             END;
  2454.  
  2455.         PrintLine;
  2456.         END;
  2457.     END;
  2458.  
  2459. {$IFC qDebug}
  2460. {--------------------------------------------------------------------------------------------------}
  2461. {$S MADebugger}
  2462.  
  2463. FUNCTION ShowHierarchy(obj: TObject;
  2464.                        theClass: ObjClassID): Longint;
  2465.  
  2466.     VAR
  2467.         inspClass:            MAName;
  2468.         size:                Longint;
  2469.         super:                ObjClassID;
  2470.         shown:                INTEGER;
  2471.  
  2472.     BEGIN
  2473.     GetClassNameFromID(theClass, inspClass);            { srf 88.9.7 }
  2474.  
  2475.     IF inspClass = kInvalidObj THEN
  2476.         BEGIN
  2477.         size := GetHandleSize(Handle(obj));
  2478.         ShowMemory(ord(Handle(obj)^), size);
  2479.         END
  2480.     ELSE
  2481.         BEGIN
  2482.         size := GetClassSizeFromID(theClass);
  2483.         super := GetSuperClassID(theClass);
  2484.         IF super = kNilClass THEN                        { it is a root class, so skip class ptr }
  2485.             shown := sizeof(ObjClassID)
  2486.         ELSE
  2487.             shown := ShowHierarchy(obj, super);
  2488.         IF shown <= size THEN
  2489.             BEGIN
  2490.             GetClassNameFromID(theClass, inspClass);
  2491.             WriteLn(' ', inspClass);
  2492.             IF size > sizeof(ObjClassID) THEN            { don't show it if there are no fields }
  2493.                 ShowMemory(ord(Handle(obj)^) + shown, size - shown);
  2494.             END;
  2495.         END;
  2496.  
  2497.     ShowHierarchy := size;
  2498.     END;
  2499.  
  2500. {--------------------------------------------------------------------------------------------------}
  2501. {$S MADebugger}
  2502.  
  2503. PROCEDURE ShowFields(obj: TObject;
  2504.                      doInspect: BOOLEAN);
  2505.  
  2506.     VAR
  2507.         i:                    Longint;
  2508.         s:                    Longint;
  2509.         objName:            MAName;
  2510.  
  2511.     BEGIN
  2512.     IF ord(obj) = - 1 THEN
  2513.         Write('')
  2514.     ELSE IF ord(obj) = - 2 THEN
  2515.         WriteLn('  No object at that level (not a method).')
  2516.     ELSE IF VerboseIsObject(obj) THEN
  2517.         BEGIN
  2518.         IF doInspect THEN
  2519.             CallInspector(obj, pInspectProc)
  2520.         ELSE
  2521.             BEGIN
  2522.             i := ShowHierarchy(obj, GetClassID(obj));
  2523.             s := GetHandleSize(Handle(obj));
  2524.             IF i < s THEN
  2525.                 BEGIN
  2526.                 WriteLn('rest of handle:');
  2527.                 ShowMemory(ord(Handle(obj)^) + i, s - i);
  2528.                 END;
  2529.             END;
  2530.         END;
  2531.     END;
  2532.  
  2533. {--------------------------------------------------------------------------------------------------}
  2534. {$S MAUtilitiesRes}                                     { Shouldn't be unloaded }
  2535.  
  2536. PROCEDURE GetLevel(level: INTEGER;
  2537.                    topFrame: Longint;
  2538.                    VAR calleeFrame, itsFrame: Longint);
  2539.  
  2540.     VAR
  2541.         i:                    INTEGER;
  2542.  
  2543.     BEGIN
  2544.     calleeFrame := topFrame;
  2545.     IF Odd(calleeFrame) THEN
  2546.         itsFrame := calleeFrame
  2547.     ELSE
  2548.         BEGIN
  2549.         itsFrame := LongIntPtr(calleeFrame)^;
  2550.         FOR i := 1 TO level DO
  2551.             IF Odd(itsFrame) | (itsFrame >= Longint(GetA5)) | (itsFrame <= calleeFrame) THEN
  2552.                 itsFrame := calleeFrame
  2553.             ELSE
  2554.                 BEGIN
  2555.                 calleeFrame := itsFrame;
  2556.                 itsFrame := LongIntPtr(itsFrame)^;
  2557.                 END;
  2558.         END;
  2559.     END;
  2560.  
  2561. {--------------------------------------------------------------------------------------------------}
  2562. {$S MADebugger}
  2563.  
  2564. PROCEDURE GetFrameInfo(calleeFrame: Longint;
  2565.                        ppc: Longint;
  2566.                        VAR callerFrame: Longint;
  2567.                        VAR itsFrame: Longint;
  2568.                        VAR itsReceiver: TObject;
  2569.                        VAR className: MAName;
  2570.                        VAR procName: MAName;
  2571.                        VAR rcvrHandle: HexAddress;
  2572.                        VAR rcvrClass: MAName;
  2573.                        VAR theSegNum: INTEGER);
  2574.  
  2575.     VAR
  2576.         aStringPtr:         StringPtr;
  2577.  
  2578.     BEGIN
  2579.     GetProcName(ppc, className, procName);
  2580.     theSegNum := GetSegFromPC(ppc);
  2581.  
  2582.     GetLevel(1, calleeFrame, itsFrame, callerFrame);
  2583.  
  2584.     rcvrClass := kInvalidObj;
  2585.     IF Odd(itsFrame) | (length(className) = 0) THEN
  2586.         BEGIN
  2587.         Longint(itsReceiver) := - 2;
  2588.         rcvrHandle := kInvalidObj;
  2589.         END
  2590.     ELSE
  2591.         BEGIN
  2592.         Longint(itsReceiver) := LongIntPtr(itsFrame + 8)^;
  2593.         aStringPtr := StringPtr(@rcvrHandle);
  2594.         PointerToHex(itsReceiver, aStringPtr^, 8);
  2595.         IF IsObject(itsReceiver) THEN
  2596.             GetClassNameFromID(GetClassID(itsReceiver), rcvrClass);
  2597.         END;
  2598.     END;
  2599.  
  2600. {--------------------------------------------------------------------------------------------------}
  2601. {$S MADebugger}
  2602.  
  2603. FUNCTION GetRcvrAtLevel(level: INTEGER;
  2604.                         topFrame: Longint): TObject;
  2605.  
  2606.     VAR
  2607.         calleeFrame, callerFrame, itsFrame: Longint;
  2608.         receiver:            TObject;
  2609.         className, procName, rcvrClass: MAName;
  2610.         rcvrHandle:         HexAddress;
  2611.         dummy:                INTEGER;
  2612.  
  2613.     BEGIN
  2614.     itsFrame := topFrame;
  2615.     REPEAT
  2616.         calleeFrame := itsFrame;
  2617.         GetFrameInfo(calleeFrame, calleeFrame + 4, callerFrame, itsFrame, receiver, className,
  2618.                      procName, rcvrHandle, rcvrClass, dummy);
  2619.         level := level - 1;
  2620.     UNTIL (level < 0) | (calleeFrame = itsFrame);
  2621.     GetRcvrAtLevel := receiver;
  2622.     END;
  2623.  
  2624. {--------------------------------------------------------------------------------------------------}
  2625. {$S MADebugger}
  2626.  
  2627. PROCEDURE ShowLocals(level: INTEGER;
  2628.                      topFrame: Longint);
  2629.  
  2630.     VAR
  2631.         startAt, finishAt:    Longint;
  2632.         itsFrame, calleeFrame: Longint;
  2633.  
  2634.     BEGIN
  2635.     GetLevel(level, topFrame, calleeFrame, itsFrame);
  2636.     startAt := max(calleeFrame + 8, itsFrame - 80);
  2637.     finishAt := itsFrame;
  2638.     ShowMemory(startAt, finishAt - startAt);
  2639.     IF pMoreMem >= finishAt THEN
  2640.         WriteLn('  The first locals declared appear last or are in reg''s.');
  2641.     END;
  2642.  
  2643. {
  2644.  calleeFrame: PREV LINK
  2645.  calleeFrame+4: PREV RA
  2646.  calleeFrame+8: PREV PARAMS
  2647.  MY LOCALS
  2648.  itsFrame: MY LINK
  2649.  itsFrame+4: MY RA
  2650.  itsFrame+8: MY PARAMS (IF A METHOD: callerFrame+8=SELF)
  2651.  NEXT LOCALS
  2652.  callerFrame: NEXT LINK
  2653.  }
  2654.  
  2655. {--------------------------------------------------------------------------------------------------}
  2656. {$S MADebugger}
  2657.  
  2658. PROCEDURE ShowParameters(level: INTEGER;
  2659.                          topFrame: Longint);
  2660.  
  2661.     VAR
  2662.         startAt, finishAt:    Longint;
  2663.         itsFrame, callerFrame: Longint;
  2664.  
  2665.     BEGIN
  2666.     GetLevel(level + 1, topFrame, itsFrame, callerFrame);
  2667.     startAt := itsFrame + 8 + 4 * ord(ord(GetRcvrAtLevel(level, topFrame)) > 0);
  2668.     finishAt := Min(startAt + 80, callerFrame);
  2669.     WriteLn('  The last argument you declared is shown first below.');
  2670.     ShowMemory(startAt, finishAt - startAt);
  2671.     END;
  2672.  
  2673. {--------------------------------------------------------------------------------------------------}
  2674. {$S MADebugger}
  2675.  
  2676. PROCEDURE ShowNames(VAR procName: MAName;
  2677.                     segNum: INTEGER);
  2678.  
  2679.     BEGIN
  2680.     Write(procName);
  2681.     IF segNum > 0 THEN
  2682.         Write(' Seg#: ', segNum: 1);
  2683.     END;
  2684.  
  2685. {--------------------------------------------------------------------------------------------------}
  2686. {$S MADebugger}
  2687.  
  2688. PROCEDURE ShowWhich(which: ZT;
  2689.                     VAR procName: MAName;
  2690.                     segNum: INTEGER);
  2691.  
  2692.     BEGIN
  2693.     CASE which OF
  2694.         tBegin:
  2695.             Write('Begin  ');
  2696.         tEnd:
  2697.             Write('End    ');
  2698.         tExit:
  2699.             Write('Exit   ');
  2700.         tBeginEndPair:
  2701.             Write('BegEnd ');
  2702.         tSysError:
  2703.             Write('SysErr ');
  2704.         tProgBreak:
  2705.             Write('Break  ');
  2706.         tVBL:
  2707.             Write('VBL Break  ');
  2708.     END;
  2709.  
  2710.     ShowNames(procName, segNum);
  2711.     END;
  2712.  
  2713. {--------------------------------------------------------------------------------------------------}
  2714. {$S MADebugger}
  2715.  
  2716. PROCEDURE ShowSymbolWhich(which: ZT;
  2717.                           VAR procName: MAName;
  2718.                           segNum: INTEGER);
  2719.  
  2720.     BEGIN
  2721.     CASE which OF
  2722.         tBegin:
  2723.             Write('>');
  2724.         tEnd:
  2725.             Write('<');
  2726.         tExit:
  2727.             Write('^ Exit: ');
  2728.         tBeginEndPair:
  2729.             Write('');
  2730.         tSysError:
  2731.             Write(': SysErr');
  2732.         tProgBreak:
  2733.             Write(': Break');
  2734.         tVBL:
  2735.             Write(': VBL Break');
  2736.     END;
  2737.     ShowNames(procName, segNum);
  2738.     END;
  2739.  
  2740. {--------------------------------------------------------------------------------------------------}
  2741. {$S MADebugger}
  2742.  
  2743. PROCEDURE ShowRecent;
  2744. { show recent history of pc.  Indents to show nesting level }
  2745.  
  2746.     CONST
  2747.         kIndentMax            = 31;                        { must be a power of 2 minus 1 }
  2748.         kIndentAmount        = 2;                        { number of spaces per nesting level }
  2749.         kDupClassName        = '=';
  2750.         kFailureProc        = 'FAILURE';
  2751.  
  2752.     VAR
  2753.         nextProcName, className, lastClassName: MAName;
  2754.         procName:            MAName;
  2755.         i:                    INTEGER;
  2756.         nexti:                INTEGER;
  2757.         pc:                 Longint;
  2758.         indentLevel, maxIndentLevel: INTEGER;
  2759.         aString:            Str255;
  2760.         aZt:                ZT;
  2761.  
  2762.     BEGIN
  2763.     { get the maximum indenting or outdenting level first }
  2764.     maxIndentLevel := 0;
  2765.     i := BAND(pRecentIndex + 1, kRecent);                { absolute value, modulo kRecent }
  2766.     REPEAT
  2767.         WITH pRecentPC[i] DO
  2768.             IF thePC <> 0 THEN
  2769.                 BEGIN
  2770.                 CASE theZT OF
  2771.                     tBegin:
  2772.                         maxIndentLevel := maxIndentLevel + kIndentAmount;
  2773.                     tEnd, tBeginEndPair:
  2774.                         maxIndentLevel := maxIndentLevel - kIndentAmount;
  2775.                     tExit: ;
  2776.                 END;
  2777.                 END;
  2778.         i := BAND(i + 1, kRecent);                        { absolute value, modulo kRecent }
  2779.     UNTIL i = pRecentIndex;
  2780.  
  2781.     { try to intelligently set a starting indent level }
  2782.     IF maxIndentLevel < 0 THEN                            { some outdenting required }
  2783.         indentLevel := Min(abs(maxIndentLevel), (kIndentMax + 1) DIV 2)
  2784.     ELSE
  2785.         indentLevel := 0;                                { only indents }
  2786.  
  2787.     lastClassName := '';
  2788.     aString := '| | | | | | | | | | | | | | | ';
  2789.     i := BAND(pRecentIndex + 1, kRecent);                { absolute value, modulo kRecent }
  2790.     REPEAT
  2791.         WITH pRecentPC[i] DO
  2792.             IF thePC <> 0 THEN
  2793.                 BEGIN
  2794.                 GetProcName(ord(@thePC), className, procName);
  2795.                 aZt := theZT;
  2796.                 nexti := BAND(i + 1, kRecent);
  2797.                 IF nexti <> pRecentIndex THEN
  2798.                     BEGIN
  2799.                     GetMethodName(ord(@pRecentPC[nexti].thePC), nextProcName);
  2800.                     IF nextProcName = procName THEN
  2801.                         BEGIN
  2802.                         aZt := tBeginEndPair;
  2803.                         i := nexti;
  2804.                         END;
  2805.                     END;
  2806.                 CASE aZt OF
  2807.                     tBegin, tBeginEndPair:
  2808.                         indentLevel := BAND(indentLevel + kIndentAmount, kIndentMax);
  2809.                 END;
  2810.                 aString[0] := CHR(indentLevel);
  2811.                 Write(aString);
  2812.                 CASE aZt OF
  2813.                     tEnd, tBeginEndPair:
  2814.                         indentLevel := BAND(indentLevel - kIndentAmount, kIndentMax);
  2815.                     tExit: ;
  2816.                 END;
  2817.                 IF IsUserBreak THEN
  2818.                     LEAVE;
  2819.                 IF (lastClassName = className) & (length(className) <> 0) THEN
  2820.                     BEGIN
  2821.                     Delete(procName, 1, length(className));
  2822.                     insert(kDupClassName, procName, 1);
  2823.                     END;
  2824.                 lastClassName := className;
  2825.                 ShowSymbolWhich(aZt, procName, - 1);
  2826.                 WriteLn;
  2827.                 IF (aZt = tExit) | ((length(className) = 0) & (procName = kFailureProc)) THEN
  2828.                     WriteLn('------------------------------');
  2829.                 END;
  2830.         i := BAND(i + 1, kRecent);                        { absolute value, modulo kRecent }
  2831.     UNTIL i = pRecentIndex;
  2832.     WriteLn;
  2833.  
  2834.     pMoreMem := - 1;
  2835.     END;
  2836.  
  2837. {--------------------------------------------------------------------------------------------------}
  2838. {$S MADebugger}
  2839.  
  2840. PROCEDURE ShowWhere;
  2841.  
  2842.     BEGIN
  2843.     ShowWhich(which, procName, segNum);
  2844.     IF ord(receiver) > 0 THEN
  2845.         Write('  Self: ', rcvrHandle, ' is ', rcvrClass);
  2846.     WriteLn;
  2847.     END;
  2848.  
  2849. {--------------------------------------------------------------------------------------------------}
  2850. {$S MADebugger}
  2851.  
  2852. PROCEDURE ShowStatus;
  2853.  
  2854.     VAR
  2855.         i:                    INTEGER;
  2856.  
  2857.     BEGIN
  2858.     Write('Trace: ');
  2859.     IF pTraceToggle THEN
  2860.         Write('ON;  ')
  2861.     ELSE
  2862.         Write('OFF; ');
  2863.  
  2864.     {$Ifc qPerform}
  2865.     Write('Performance Monitor: ');
  2866.     IF oldState THEN
  2867.         Write('ON;  ')
  2868.     ELSE
  2869.         Write('OFF; ');
  2870.     {$Endc}
  2871.  
  2872.     IF pBreakCount > 0 THEN
  2873.         BEGIN
  2874.         Write('Break[s] set at: ');
  2875.         FOR i := 1 TO pBreakCount DO
  2876.             BEGIN
  2877.             IF i > 1 THEN
  2878.                 Write(', ');
  2879.             IF pBreakClass[i] <> '' THEN
  2880.                 Write(pBreakClass[i], '.', pBreakProc[i])
  2881.             ELSE
  2882.                 Write(pBreakProc[i]);
  2883.             END;
  2884.         END
  2885.     ELSE
  2886.         Write('No Break set.');
  2887.  
  2888.     WriteLn;
  2889.  
  2890.     Write('Last Broke at: ');
  2891.     ShowWhere;
  2892.     END;
  2893.  
  2894. {--------------------------------------------------------------------------------------------------}
  2895. {$S MADebugger}
  2896.  
  2897. PROCEDURE ShowStack;
  2898.  
  2899.     VAR
  2900.         startLevel:         INTEGER;
  2901.         interrupted:        BOOLEAN;
  2902.     {??? moved strings out to this level to help reduce the stack rqs of recursion.
  2903.     Eventually should fix even better than this ???}
  2904.         className:            MAName;
  2905.         procName:            MAName;
  2906.         rcvrClass:            MAName;
  2907.         rcvrHandle:         HexAddress;
  2908.  
  2909. {--------------------------------------------------------------------------------------------------}
  2910.  
  2911.     PROCEDURE ShowLevel(level: INTEGER;
  2912.                         calleeFrame, ppc: Longint);
  2913.  
  2914.         VAR
  2915.             callerFrame:        Longint;
  2916.             itsFrame:            Longint;
  2917.             receiver:            TObject;
  2918.             segNum:             INTEGER;
  2919.  
  2920.         BEGIN
  2921.         GetFrameInfo(calleeFrame, ppc, callerFrame, itsFrame, receiver, className, procName,
  2922.                      rcvrHandle, rcvrClass, segNum);
  2923.  
  2924.         IF calleeFrame <> itsFrame THEN
  2925.             BEGIN
  2926.             nextLevel := level + 1;
  2927.             nextFrame := itsFrame;
  2928.             pNextPC := itsFrame + 4;
  2929.             IF nextLevel < startLevel + 10 THEN
  2930.                 ShowLevel(nextLevel, nextFrame, pNextPC)
  2931.             ELSE
  2932.                 pMoreMem := 0;                            {Signal that "More" command is available}
  2933.             END;
  2934.  
  2935.         IF NOT interrupted THEN
  2936.             BEGIN
  2937.             Write(' ', level: 3, ' ');
  2938.             WritePtr(calleeFrame);
  2939.             Write(': ');
  2940.  
  2941.             { retrieve names for this frame again }
  2942.             GetFrameInfo(calleeFrame, ppc, callerFrame, itsFrame, receiver, className, procName,
  2943.                          rcvrHandle, rcvrClass, segNum);
  2944.  
  2945.             ShowNames(procName, segNum);
  2946.             IF ord(receiver) > 0 THEN
  2947.                 Write('  Self: ', rcvrHandle, ' is ', rcvrClass);
  2948.             WriteLn;
  2949.             interrupted := IsUserBreak;
  2950.             END;
  2951.         END;
  2952.  
  2953.     BEGIN
  2954.     pMoreMem := - 1;
  2955.     interrupted := FALSE;
  2956.     startLevel := nextLevel;
  2957.  
  2958.     ShowLevel(startLevel, nextFrame, pNextPC);
  2959.  
  2960.     IF pMoreMem = 0 THEN
  2961.         WriteLn('More… [M]: ');
  2962.     END;
  2963.  
  2964. {--------------------------------------------------------------------------------------------------}
  2965. {$S MAUtilitiesRes}                                     { Shouldn't be unloaded }
  2966. {$Push} {$Z+}
  2967.  
  2968. PROCEDURE EachFrameDo(calleeFrame, ppc: Longint;
  2969.                       PROCEDURE DoToFrame(calleeFrame: Longint;
  2970.                                           ppc: Longint;
  2971.                                           callerFrame: Longint;
  2972.                                           itsFrame: Longint));
  2973.  
  2974.     PROCEDURE DoLevel(calleeFrame, ppc: Longint);
  2975.  
  2976.         VAR
  2977.             callerFrame:        Longint;
  2978.             itsFrame:            Longint;
  2979.             nextFrame:            Longint;
  2980.             pNextPC:            Longint;
  2981.  
  2982.         BEGIN
  2983.         GetLevel(1, calleeFrame, itsFrame, callerFrame);
  2984.         DoToFrame(calleeFrame, ppc, callerFrame, itsFrame);
  2985.         IF calleeFrame <> itsFrame THEN
  2986.             BEGIN
  2987.             nextFrame := itsFrame;
  2988.             pNextPC := itsFrame + 4;
  2989.             DoLevel(nextFrame, pNextPC)
  2990.             END;
  2991.         END;
  2992.  
  2993.     BEGIN
  2994.     DoLevel(calleeFrame, ppc);
  2995.     END;
  2996. {$Pop}
  2997.  
  2998. {--------------------------------------------------------------------------------------------------}
  2999. {$S MADebugger}
  3000.  
  3001. PROCEDURE ShowTempSpace(VAR lockedSpace, totalSpace: Longint);
  3002.  
  3003.     VAR
  3004.         seg:                Handle;
  3005.  
  3006.     BEGIN
  3007.     lockedSpace := TotalTempSize(true, seg);
  3008.     totalSpace := TotalTempSize(FALSE, seg);
  3009.  
  3010.     WriteLn('  Current temp space: locked = ', lockedSpace: 1, ', unlocked = ', totalSpace -
  3011.             lockedSpace: 1, ', total = ', totalSpace: 1);
  3012.  
  3013.     END;
  3014.  
  3015. {--------------------------------------------------------------------------------------------------}
  3016. {$S MADebugger}
  3017.  
  3018. PROCEDURE ShowHeapInfo;
  3019.  
  3020.     VAR
  3021.         codeRes:            Longint;
  3022.         codeShort:            Longint;
  3023.         lockedSpace:        Longint;
  3024.         lowSpaceRes:        Longint;
  3025.         okCode:             BOOLEAN;
  3026.         okLowSpace:         BOOLEAN;
  3027.         oldPerm:            BOOLEAN;
  3028.         oldRsrcUse:         Longint;
  3029.         purgeSpace:         Longint;
  3030.         totalSpace:         Longint;
  3031.  
  3032.     BEGIN
  3033.     oldRsrcUse := gMaxLockedRsrc;
  3034.  
  3035.     {== S T A C K ==}
  3036.     WriteLn('STACK');
  3037.     WriteLn('  Current total stack = ', pStackSpace: 1, '           Maximum stack used = ',
  3038.             gMaxStackDepth: 1);
  3039.     WriteLn('  Current procedure stack = ', pProcStack: 1, '           Available stack = ',
  3040.             ord(GetCurStackBase) - ord(GetApplLimit): 1);
  3041.  
  3042.     IF pBreakStack < $7FFFFFFF THEN
  3043.         WriteLn('Break at total stack space = ', pBreakStack: 1);
  3044.     IF pBrProcStack < $7FFFFFFF THEN
  3045.         WriteLn('Break at procedure stack space = ', pBrProcStack: 1);
  3046.  
  3047.     {== R E S E R V E S ==}
  3048.     WriteLn('RESERVES');
  3049.     DoChangeReserve(FALSE, codeRes, codeShort, lowSpaceRes, okCode, okLowSpace);
  3050.  
  3051.     Write('  code = ', codeRes: 1);
  3052.     IF okCode THEN
  3053.         Write(' (OK)')
  3054.     ELSE
  3055.         Write(' (low: ', codeShort: 1, ')');
  3056.  
  3057.     Write('     low space = ', lowSpaceRes: 1);
  3058.     IF okLowSpace THEN
  3059.         Write(' (OK)')
  3060.     ELSE
  3061.         Write(' (gone)');
  3062.  
  3063.     Write('  allocation flag: ');
  3064.     IF pPermFlag THEN
  3065.         WriteLn('permanent')
  3066.     ELSE
  3067.         WriteLn('temporary');
  3068.  
  3069.     {== T E M P  S P A C E ==}
  3070.     WriteLn('TEMP SPACE');
  3071.     ShowTempSpace(lockedSpace, totalSpace);
  3072.  
  3073.     purgeSpace := totalSpace - codeRes;
  3074.     IF purgeSpace > (totalSpace - lockedSpace) THEN
  3075.         purgeSpace := totalSpace - lockedSpace;
  3076.  
  3077.     IF purgeSpace >= 0 THEN
  3078.         WriteLn('  Purgeable temp space = ', purgeSpace: 1)
  3079.     ELSE
  3080.         WriteLn('  Needed reserve handle size = ', - purgeSpace: 1);
  3081.  
  3082.     {== O T H E R ==}
  3083.     WriteLn('OTHER');
  3084.     CheckRsrcUsage;
  3085.  
  3086.     Write('  Max resource usage = ', gMaxLockedRsrc: 1);
  3087.     IF oldRsrcUse <> gMaxLockedRsrc THEN
  3088.         WriteLn(' (new)')
  3089.     ELSE
  3090.         WriteLn;
  3091.  
  3092.     gMaxLockedRsrc := oldRsrcUse;                        { so we get the '(new)' indications again }
  3093.  
  3094.     oldPerm := PermAllocation(true);
  3095.     totalSpace := FreeMem;
  3096.     oldPerm := PermAllocation(oldPerm);
  3097.  
  3098.     WriteLn('  (permanent) FreeMem = ', totalSpace: 1, '            Free master pointers = ',
  3099.             GetFreeMastersCount: 1);
  3100.     END;
  3101.  
  3102. {--------------------------------------------------------------------------------------------------}
  3103. {$S MADebugger}
  3104.  
  3105. PROCEDURE HeapCmd;
  3106.  
  3107.     VAR
  3108.         ch:                 CHAR;
  3109.         decNum:             Longint;
  3110.         done:                BOOLEAN;
  3111.         hexNum:             Longint;
  3112.         x:                    Longint;
  3113.         y:                    Longint;
  3114.  
  3115.         id:                 INTEGER;
  3116.         name:                Str255;
  3117.         nSeg:                INTEGER;
  3118.         seg:                Handle;
  3119.         t:                    ResType;
  3120.  
  3121.         codeRes:            Longint;
  3122.         codeShort:            Longint;
  3123.         lowSpaceRes:        Longint;
  3124.         okCode:             BOOLEAN;
  3125.         okLowSpace:         BOOLEAN;
  3126.         oldPerm:            BOOLEAN;
  3127.  
  3128.     PROCEDURE helpProc;
  3129.  
  3130.         BEGIN
  3131.         WriteLn;
  3132.         WriteLn('+ -- set breakpoint on procedure stack usage');
  3133.         WriteLn('B -- set breakpoint on total stack usage');
  3134.         WriteLn('D -- reset maximum stack depth');
  3135.         WriteLn('I -- show heap/stack info');
  3136.         WriteLn('M -- show heap/stack info AND MaxMem');
  3137.         WriteLn('R -- show/set heap reserve');
  3138.         WriteLn('S -- list LOADED segments');
  3139.         WriteLn('ß (option-S) -- list ALL segments');
  3140.         WriteLn;
  3141.         END;
  3142.  
  3143.     PROCEDURE ShowSegments(allSegments: BOOLEAN);
  3144.     { Show segment information.  if allSegments is true then also show unloaded & purged }
  3145.  
  3146.         VAR
  3147.             i:                    INTEGER;
  3148.  
  3149.         BEGIN
  3150.         codeRes := 0;                                    { counts size of code segments }
  3151.  
  3152.         nSeg := GetHandleSize(Handle(gCodeSegs)) DIV sizeof(Handle);
  3153.  
  3154.         WriteLn('Total # segments = ', nSeg: 1);
  3155.         IF allSegments THEN
  3156.             WriteLn(
  3157.         '• = resident, L = loaded, U = unloaded (and relocatable), '' '' = purged (or never loaded)'
  3158.                     )
  3159.         ELSE
  3160.             WriteLn('• = resident, L = loaded');
  3161.  
  3162.         FOR i := 1 TO nSeg DO
  3163.             BEGIN
  3164.             seg := gCodeSegs^^[i];
  3165.             IF allSegments | (NOT IsHandlePurged(seg) & isHandleLocked(seg)) THEN
  3166.                 BEGIN
  3167.                 GetResInfo(seg, id, t, name);
  3168.  
  3169.                 WritePtr(seg);
  3170.  
  3171.                 Write('  Seg#:', id: 3, ' ');
  3172.  
  3173.                 IF gIsResidentSeg^^[i] THEN
  3174.                     Write('• ')
  3175.                 ELSE IF IsHandlePurged(seg) THEN
  3176.                     Write('  ')
  3177.                 ELSE IF gIsLoadedSeg^^[i] THEN
  3178.                     Write('L ')
  3179.                 ELSE
  3180.                     Write('U ');
  3181.  
  3182.                 Write(name, ' ': 25 - length(name), ' ');
  3183.  
  3184.                 WriteLn(pSegSize^^[i]: 6, ' bytes');
  3185.  
  3186.                 codeRes := codeRes + pSegSize^^[i] + 8;
  3187.                 END;
  3188.             END;
  3189.  
  3190.         WriteLn;
  3191.         WriteLn('Total loaded code = ', codeRes: 1);
  3192.         ShowTempSpace(x, y);
  3193.         END;
  3194.  
  3195.     BEGIN
  3196.     done := FALSE;
  3197.     REPEAT
  3198.         ch := GetPromptedChar(AtStr('Heap/Stack Cmd'), AtStr('+BDIMRSß'), helpProc);
  3199.  
  3200.         CASE ch OF
  3201.             '+':
  3202.                 BEGIN
  3203.                 IF GetPromptedNumber(AtStr('Break at what procedure stack usage?: '), decNum,
  3204.                                      hexNum) THEN
  3205.  
  3206.                     IF decNum = 0 THEN
  3207.                         pBrProcStack := $7FFFFFFF
  3208.                     ELSE IF decNum > 0 THEN
  3209.                         pBrProcStack := decNum;
  3210.  
  3211.                 ShowHeapInfo;
  3212.  
  3213.                 done := true;
  3214.                 END;
  3215.  
  3216.             'B':
  3217.                 BEGIN
  3218.                 IF GetPromptedNumber(AtStr('Break at what total stack usage?: '), decNum,
  3219.                    hexNum) THEN
  3220.                     IF decNum = 0 THEN
  3221.                         pBreakStack := $7FFFFFFF
  3222.                     ELSE IF decNum > 0 THEN
  3223.                         pBreakStack := decNum;
  3224.  
  3225.                 ShowHeapInfo;
  3226.  
  3227.                 done := true;
  3228.                 END;
  3229.  
  3230.             'D':
  3231.                 BEGIN
  3232.                 gMaxStackDepth := - 1;
  3233.  
  3234.                 ShowHeapInfo;
  3235.  
  3236.                 done := true;
  3237.                 END;
  3238.  
  3239.             'I':
  3240.                 BEGIN
  3241.                 ShowHeapInfo;
  3242.                 done := true;
  3243.                 END;
  3244.  
  3245.             'M':
  3246.                 BEGIN
  3247.                 oldPerm := PermAllocation(true);
  3248.                 x := MaxMem(decNum);
  3249.                 oldPerm := PermAllocation(oldPerm);
  3250.  
  3251.                 ShowHeapInfo;
  3252.  
  3253.                 WriteLn('(permanent) MaxMem = ', x: 1);
  3254.  
  3255.                 done := true;
  3256.                 END;
  3257.  
  3258.             'R':
  3259.                 BEGIN
  3260.                 DoChangeReserve(true, codeRes, codeShort, lowSpaceRes, okCode, okLowSpace);
  3261.                 ShowHeapInfo;
  3262.                 done := true;
  3263.                 END;
  3264.  
  3265.             'S':
  3266.                 BEGIN
  3267.                 ShowSegments(FALSE);
  3268.  
  3269.                 done := true;
  3270.                 END;
  3271.  
  3272.             'ß':
  3273.                 BEGIN
  3274.                 ShowSegments(true);
  3275.  
  3276.                 done := true;
  3277.                 END;
  3278.  
  3279.             OTHERWISE
  3280.                 done := true;
  3281.         END;
  3282.     UNTIL done;
  3283.     END;
  3284.  
  3285. {--------------------------------------------------------------------------------------------------}
  3286. {$S MADebugger}
  3287.  
  3288. PROCEDURE PositionDebugWindow(where: CHAR);
  3289.  
  3290.     VAR
  3291.         theEvent:            EventRecord;
  3292.  
  3293.     BEGIN
  3294.     CASE where OF
  3295.         'B':
  3296.             BEGIN
  3297.             SendBehind(pDebugWindow.fWMgrWindow, NIL);
  3298.             WHILE GetNextEvent(activMask, theEvent) DO; { suck up the activate/deactivate }
  3299.             HiliteWindow(pDebugWindow.fWMgrWindow, true);
  3300.             END;
  3301.         'F':
  3302.             BringToFront(pDebugWindow.fWMgrWindow);
  3303.     END;
  3304.     END;
  3305.  
  3306. {--------------------------------------------------------------------------------------------------}
  3307. {$S MADebugger}
  3308.  
  3309. PROCEDURE WindCmd;
  3310.  
  3311.     CONST
  3312.         kVMargin            = 4;
  3313.         kHMargin            = 4;
  3314.  
  3315.     VAR
  3316.         done:                BOOLEAN;
  3317.         ch:                 CHAR;
  3318.         aTextStyle:         TextStyle;
  3319.  
  3320.     PROCEDURE helpProc;
  3321.  
  3322.         BEGIN
  3323.         WriteLn;
  3324.         WriteLn('B -- send debug window to the back');
  3325.         WriteLn('F -- bring debug window to front');
  3326.         WriteLn('ƒ -- specify a font');
  3327.         WriteLn('S -- specify a font size');
  3328.         WriteLn;
  3329.         END;
  3330.  
  3331.     PROCEDURE InstallTheStyle(aTextStyle: TextStyle);
  3332.  
  3333.         VAR
  3334.             zoomedOutSize:        Point;
  3335.  
  3336.         BEGIN
  3337.         {$Push} {$H-}
  3338.         zoomedOutSize := VPtToPt(pDebugView.fSize);
  3339.         {$Pop}
  3340.         WITH zoomedOutSize DO
  3341.             BEGIN
  3342.             v := (2 * kVMargin) + (pDebugView.fFontHeight * (pDebugView.fRows));
  3343.             v := max(kSBarSize * 4, v + kSBarSize);
  3344.             h := max(kSBarSize * 4, h + kSBarSize);
  3345.             END;
  3346.  
  3347.         pDebugWindow.SetResizeLimits(gStdWSizeRect.topLeft, zoomedOutSize);
  3348.         pDebugView.InstallTextStyle(aTextStyle);
  3349.         pDebugView.ForceRedraw;
  3350.         END;
  3351.  
  3352.     PROCEDURE FontHelpProc;
  3353.  
  3354.         VAR
  3355.             theCount, i:        INTEGER;
  3356.             h:                    Handle;
  3357.             oldResLoad:         BOOLEAN;
  3358.             theID:                INTEGER;
  3359.             theType:            ResType;
  3360.             name:                Str255;
  3361.  
  3362.         BEGIN
  3363.         WriteLn;
  3364.         theCount := CountResources('FOND');
  3365.         FOR i := 1 TO theCount DO
  3366.             BEGIN
  3367.             oldResLoad := GetResLoad;
  3368.             SetResLoad(FALSE);
  3369.             h := GetIndResource('FOND', i);
  3370.             IF h <> NIL THEN
  3371.                 BEGIN
  3372.                 GetResInfo(h, theID, theType, name);
  3373.                 SetResLoad(oldResLoad);
  3374.                 WriteLn(name);
  3375.                 END
  3376.             ELSE
  3377.                 SetResLoad(oldResLoad);
  3378.             END;
  3379.         END;
  3380.  
  3381.     BEGIN
  3382.     done := FALSE;
  3383.     REPEAT
  3384.         ch := GetPromptedChar(AtStr('Window Cmd'), AtStr('BFƒS'), helpProc);
  3385.  
  3386.         CASE ch OF
  3387.             'B', 'F':
  3388.                 BEGIN
  3389.                 PositionDebugWindow(ch);
  3390.                 done := true;
  3391.                 END;
  3392.             'ƒ':                                        {??? from a menu some other time }
  3393.                 BEGIN
  3394.                 aTextStyle := pDebugView.fTextStyle;
  3395.                 aTextStyle.tsFont := GetFontNum(GetPromptedString(AtStr('Enter font name?: '),
  3396.                                                                   FontHelpProc));
  3397.                 InstallTheStyle(aTextStyle);
  3398.                 done := true;
  3399.                 END;
  3400.             'S':                                        {??? from a menu some other time }
  3401.                 BEGIN
  3402.                 IF GetPromptedNumber(AtStr('Enter font size?: '), asDecimal, asHex) THEN
  3403.                     BEGIN
  3404.                     aTextStyle := pDebugView.fTextStyle;
  3405.                     aTextStyle.tsSize := asDecimal;
  3406.                     InstallTheStyle(aTextStyle);
  3407.                     END;
  3408.                 done := true;
  3409.                 END;
  3410.             OTHERWISE
  3411.                 done := true;
  3412.         END;
  3413.     UNTIL done;
  3414.     END;
  3415.  
  3416. {--------------------------------------------------------------------------------------------------}
  3417. {$S MADebugger}
  3418.  
  3419. PROCEDURE SetBreakCmd;
  3420.  
  3421.     VAR
  3422.         done:                BOOLEAN;
  3423.         ch:                 CHAR;
  3424.         aClassName, aProcName: MAName;
  3425.  
  3426.     BEGIN
  3427.     IF pBreakCount < 10 THEN
  3428.         BEGIN
  3429.         IF GetPromptedNames(AtStr('Break at [Typename.ProcName or ProcName]?: '), aClassName,
  3430.                             aProcName) THEN
  3431.             BEGIN
  3432.             pBreakCount := pBreakCount + 1;
  3433.             pBreakClass[pBreakCount] := aClassName;
  3434.             pBreakProc[pBreakCount] := aProcName;
  3435.             END
  3436.         END
  3437.     ELSE
  3438.         WriteLn('Already have maximum breakpoints set!');
  3439.     ShowStatus;
  3440.     END;
  3441.  
  3442. {--------------------------------------------------------------------------------------------------}
  3443. {$S MADebugger}
  3444.  
  3445. PROCEDURE ClrBreakCmd;
  3446.  
  3447.     VAR
  3448.         aString:            Str255;
  3449.         whichBreak:         Longint;
  3450.  
  3451.     PROCEDURE ClrBreakHelp;
  3452.  
  3453.         VAR
  3454.             i:                    INTEGER;
  3455.  
  3456.         BEGIN
  3457.         WriteLn;
  3458.         WriteLn('A - All breakpoints');
  3459.         FOR i := 1 TO pBreakCount DO
  3460.             BEGIN
  3461.             Write(i: 1, ' - ');
  3462.             IF pBreakClass[i] <> '' THEN
  3463.                 WriteLn(pBreakClass[i], '.', pBreakProc[i])
  3464.             ELSE
  3465.                 WriteLn(pBreakProc[i]);
  3466.             END;
  3467.         END;
  3468.  
  3469.     BEGIN
  3470.     CASE pBreakCount OF
  3471.         0:
  3472.             WriteLn('No breakpoints are set!.');
  3473.         1:
  3474.             BEGIN
  3475.             pBreakCount := 0;
  3476.             WriteLn('Cleared the breakpoint.');
  3477.             END;
  3478.         OTHERWISE
  3479.             BEGIN
  3480.             aString := concat(ConcatNumber('Which breakpoint[1-', pBreakCount), ',A]?:');
  3481.             aString := GetPromptedString(@aString, ClrBreakHelp);
  3482.             UprStr255(aString);
  3483.             IF aString = 'A' THEN
  3484.                 BEGIN
  3485.                 pBreakCount := 0;
  3486.                 WriteLn('Cleared all the breakpoints.');
  3487.                 END
  3488.             ELSE IF aString <> '' THEN
  3489.                 BEGIN
  3490.                 StringToNum(aString, whichBreak);
  3491.                 IF (whichBreak > 0) & (whichBreak <= pBreakCount) THEN
  3492.                     BEGIN
  3493.                     WHILE whichBreak < pBreakCount DO
  3494.                         BEGIN
  3495.                         pBreakClass[whichBreak] := pBreakClass[whichBreak + 1];
  3496.                         pBreakProc[whichBreak] := pBreakProc[whichBreak + 1];
  3497.                         whichBreak := whichBreak + 1;
  3498.                         END;
  3499.                     pBreakCount := pBreakCount - 1;
  3500.                     WriteLn('Cleared the breakpoint.');
  3501.                     END;
  3502.                 END;
  3503.             END;
  3504.     END;
  3505.     ShowStatus;
  3506.     END;
  3507.  
  3508. {--------------------------------------------------------------------------------------------------}
  3509. {$Ifc qPerform}
  3510. {$S MADebugger}
  3511.  
  3512. PROCEDURE PerfCmd;
  3513.  
  3514.     VAR
  3515.         done:                BOOLEAN;
  3516.         ch:                 CHAR;
  3517.         aBool:                BOOLEAN;
  3518.         perfErr:            INTEGER;
  3519.         s:                    Str255;
  3520.         ms:                 INTEGER;
  3521.         apName:             Str255;
  3522.         apRefnum:            INTEGER;
  3523.         apParam:            Handle;
  3524.  
  3525.     PROCEDURE helpProc;
  3526.  
  3527.         BEGIN
  3528.         WriteLn;
  3529.         WriteLn('D -- Dump to output file');
  3530.         WriteLn('E -- End the tools and free their storage');
  3531.         WriteLn('I -- Init performance tools');
  3532.         WriteLn('T -- Toggle tools on and off');
  3533.         WriteLn;
  3534.         END;
  3535.  
  3536.     PROCEDURE appCodeTypeHelpProc;
  3537.  
  3538.         BEGIN
  3539.         WriteLn;
  3540.         WriteLn('Please specify the resource type to measure');
  3541.         WriteLn;
  3542.         END;
  3543.  
  3544.     PROCEDURE romNameHelpProc;
  3545.  
  3546.         BEGIN
  3547.         WriteLn;
  3548.         WriteLn('Please specify the ROM name');
  3549.         WriteLn;
  3550.         END;
  3551.  
  3552.     PROCEDURE reportFileHelpProc;
  3553.  
  3554.         BEGIN
  3555.         WriteLn;
  3556.         WriteLn('Please specify a file name for the report');
  3557.         WriteLn;
  3558.         END;
  3559.  
  3560.     BEGIN
  3561.     done := FALSE;
  3562.     REPEAT
  3563.         ch := GetPromptedChar(AtStr('Performance Cmd'), AtStr('DEIT'), helpProc);
  3564.  
  3565.         CASE ch OF
  3566.             'D':
  3567.                 BEGIN
  3568.                 IF pTP2PerfGlobals <> NIL THEN
  3569.                     BEGIN
  3570.                     WriteLn('Dump performance tools data.  Press Return to take the default…');
  3571.                     GetAppParms(apName, apRefnum, apParam);
  3572.                     s := concat(apName, '.perf');
  3573.                     perfErr := PerfDump(pTP2PerfGlobals,
  3574.                                         GetPromptedStringWithDefault(AtStr('  reportFile'), @s,
  3575.                                         reportFileHelpProc), GetPromptedNumberWithDefault(AtStr(
  3576.                                         '  doHistogram (TRUE=1/FALSE=0)'), 0) = 1,
  3577.                                         GetPromptedNumberWithDefault(AtStr('  rptFileColumns'),
  3578.                                80));
  3579.                     IF perfErr <> noErr THEN
  3580.                         WriteLn('Error: ', perfErr, ' while dumping');
  3581.                     END
  3582.                 ELSE
  3583.                     WriteLn('Not initialized!');
  3584.                 done := true;
  3585.                 END;
  3586.             'E':
  3587.                 BEGIN
  3588.                 IF pTP2PerfGlobals <> NIL THEN
  3589.                     BEGIN
  3590.                     TermPerf(pTP2PerfGlobals);
  3591.                     pTP2PerfGlobals := NIL;
  3592.                     END
  3593.                 ELSE
  3594.                     WriteLn('Not initialized!');
  3595.                 done := true;
  3596.                 END;
  3597.             'I':
  3598.                 BEGIN
  3599.                 IF pTP2PerfGlobals = NIL THEN
  3600.                     BEGIN
  3601.                     WriteLn('Init performance tools.  Press Return to take the default…');
  3602.                     { set the default }
  3603.                     CASE gConfiguration.machineType OF
  3604.                         envMac, envXL, env512KE, envMacPlus, envSE:
  3605.                             ms := 10;
  3606.                         OTHERWISE
  3607.                             ms := 4;
  3608.                     END;
  3609.                     aBool := InitPerf(pTP2PerfGlobals,
  3610.                                       GetPromptedNumberWithDefault(AtStr('  timerCount'), ms),
  3611.                                       GetPromptedNumberWithDefault(AtStr('  codeAndROMBucketSize'),
  3612.                                                                    8),
  3613.                                       GetPromptedNumberWithDefault(AtStr('  doROM (TRUE=1/FALSE=0)'
  3614.                                                                           ), 0) = 1,
  3615.                                       GetPromptedNumberWithDefault(AtStr(
  3616.                                                                       '  doAppCode (TRUE=1/FALSE=0)'
  3617.                                                                          ), 1) = 1,
  3618.                                       GetPromptedStringWithDefault(AtStr('  appCodeType'),
  3619.                                                                    AtStr('CODE'),
  3620.                                                                    appCodeTypeHelpProc),
  3621.                                       GetPromptedNumberWithDefault(AtStr('  romID'), 0),
  3622.                                       GetPromptedStringWithDefault(AtStr('  romName'), AtStr(''),
  3623.                                                                    romNameHelpProc),
  3624.                                       GetPromptedNumberWithDefault(AtStr('  doRAM (TRUE=1/FALSE=0)')
  3625.                                                                    , 0) = 1,
  3626.                                       GetPromptedNumberWithDefault(AtStr('  ramLow'), 0),
  3627.                                       GetPromptedNumberWithDefault(AtStr('  ramHigh'), 0),
  3628.                                       GetPromptedNumberWithDefault(AtStr('  ramBucketSize'), 8));
  3629.                     IF NOT aBool THEN
  3630.                         WriteLn('Performance tools initialization FAILED.');
  3631.                     END
  3632.                 ELSE
  3633.                     WriteLn('Already initialized!');
  3634.  
  3635.                 done := true;
  3636.                 END;
  3637.             'T':
  3638.                 BEGIN
  3639.                 IF pTP2PerfGlobals <> NIL THEN
  3640.                     BEGIN
  3641.                     oldState := NOT oldState;
  3642.                     ShowStatus;
  3643.                     END
  3644.                 ELSE
  3645.                     WriteLn('Not initialized!');
  3646.                 done := true;
  3647.                 END;
  3648.             OTHERWISE
  3649.                 done := true;
  3650.         END;
  3651.     UNTIL done;
  3652.     END;
  3653. {$Endc}
  3654. {--------------------------------------------------------------------------------------------------}
  3655. {$S MADebugger}
  3656.  
  3657. PROCEDURE ToggleCmd;
  3658.  
  3659.     VAR
  3660.         done:                BOOLEAN;
  3661.         ch:                 CHAR;
  3662.         i:                    INTEGER;
  3663.         theFlags:            Str255;
  3664.         newState:            BOOLEAN;
  3665.  
  3666.     PROCEDURE FlagInfo(desc: StringHandle;
  3667.                        addr: BooleanPtr);
  3668.  
  3669.         BEGIN
  3670.         HLock(Handle(desc));
  3671.         {$Push} {$H-}
  3672.         Write(desc^^, ': ');
  3673.         {$Pop}
  3674.         HUnLock(Handle(desc));
  3675.         IF addr^ THEN
  3676.             WriteLn('TRUE')
  3677.         ELSE
  3678.             WriteLn('FALSE');
  3679.         END;
  3680.  
  3681.     PROCEDURE helpProc;
  3682.  
  3683.         VAR
  3684.             i:                    INTEGER;
  3685.  
  3686.         BEGIN
  3687.         WriteLn;
  3688.         FOR i := 1 TO pFlagsInUse DO
  3689.             WITH pFlagTable[i] DO
  3690.                 BEGIN
  3691.                 Write(ch, ' -- ');
  3692.                 FlagInfo(desc, addr);
  3693.                 END;
  3694.         WriteLn;
  3695.         END;
  3696.  
  3697.     BEGIN
  3698.     done := FALSE;
  3699.     REPEAT
  3700.         theFlags := '';
  3701.         FOR i := 1 TO pFlagsInUse DO
  3702.             BEGIN
  3703.             IF pFlagTable[i].addr^ THEN
  3704.                 theFlags[length(theFlags) + 1] := UprChar(pFlagTable[i].ch)
  3705.             ELSE
  3706.                 theFlags[length(theFlags) + 1] := LowerChar(pFlagTable[i].ch);
  3707.             theFlags[0] := CHR(length(theFlags) + 1);
  3708.             END;
  3709.  
  3710.         ch := GetPromptedChar(AtStr('Toggle Flag'), @theFlags, helpProc);
  3711.         CASE ch OF
  3712.             chReturn:
  3713.                 done := true;
  3714.             OTHERWISE
  3715.                 BEGIN
  3716.                 i := 1;
  3717.                 WHILE NOT done & (i <= pFlagsInUse) DO
  3718.                     BEGIN
  3719.                     IF pFlagTable[i].ch = ch THEN
  3720.                         BEGIN
  3721.                         newState := NOT pFlagTable[i].addr^;
  3722.                         IF pFlagTable[i].actionProc <> NIL THEN
  3723.                             IF CallFlagActionProc(newState, pFlagTable[i].actionProc) THEN; {
  3724.                             discard result }
  3725.                         pFlagTable[i].addr^ := newState;
  3726.                         FlagInfo(pFlagTable[i].desc, pFlagTable[i].addr);
  3727.                         done := true;
  3728.                         END;
  3729.                     i := i + 1;
  3730.                     END;
  3731.                 END;
  3732.         END;
  3733.     UNTIL done;
  3734.     END;
  3735.  
  3736. {--------------------------------------------------------------------------------------------------}
  3737. {$S MADebugger}
  3738.  
  3739. PROCEDURE MainHelpProc;
  3740.  
  3741.     BEGIN
  3742.     WriteLn;
  3743.     Write('A5: ');
  3744.     WritePtr(GetA5);
  3745.     Write('; thePort: ');
  3746.     WritePtr(pSavedState.pFocusRec.Port);
  3747.     WriteLn;
  3748.     ShowStatus;
  3749.     WriteLn('?/Help -- Display Help');
  3750.     WriteLn('/ -- Show Status');
  3751.     WriteLn('B -- Set a breakpoint');
  3752.     WriteLn('C -- Clear a breakpoint');
  3753.     WriteLn('D -- Display Memory');
  3754.     {$IFC IncludeDisassembler}
  3755.     WriteLn('∂ (option-d) -- Disassemble Memory');
  3756.     {$EndC}
  3757.     WriteLn('E -- Enter Macsbug (or other low-level debugger)');
  3758.     WriteLn('F -- Fields');
  3759.     WriteLn('G -- Go');
  3760.     WriteLn('H -- Heap & Stack…');
  3761.     WriteLn('I -- Inspect');
  3762.     WriteLn('L -- Locals');
  3763.     WriteLn('M -- More');
  3764.     {$IFC IncludeDisassembler}
  3765.     WriteLn('µ (option-m) -- Disassemble More');
  3766.     {$EndC}
  3767.     WriteLn('O -- Output Redirection');
  3768.     WriteLn('P -- Parameters');
  3769.     {$Ifc qPerform}
  3770.     WriteLn('π (option-p) -- Performance Monitor…');
  3771.     {$Endc}
  3772.     WriteLn('Q -- Quit');
  3773.     WriteLn('R -- Recent PC history');
  3774.     WriteLn('S -- Stack Crawl');
  3775.     WriteLn('ß (option-s) -- Signal Failure(0, 0)');
  3776.     WriteLn('T -- Trace toggle');
  3777.     WriteLn('W -- Window…');
  3778.     WriteLn('X -- Toggle Flag…');
  3779.     WriteLn('Space -- Single step OVER deeper levels');
  3780.     WriteLn('Option-Space -- Single step INTO deeper levels');
  3781.     WriteLn('Cmd-BS/Cmd-CR, Arrows, Page keys -- Scroll');
  3782.     WriteLn('Cmd-` -- Break at normal entry');
  3783.     WriteLn('Cmd-Option-Shift -- Break at next procedure boundary');
  3784.     WriteLn('Cmd-Option-Control-Shift -- Break at next VBL (Danger Will Robinson!)');
  3785.     WriteLn;
  3786.     END;
  3787.  
  3788. {--------------------------------------------------------------------------------------------------}
  3789. {$S MADebugger}
  3790.  
  3791. PROCEDURE DoWaiting;
  3792.  
  3793.     CONST
  3794.         chOptionSpace        = ' ';
  3795.  
  3796.     VAR
  3797.         error, message:     INTEGER;
  3798.         gotSymbol:            BOOLEAN;
  3799.         savedScript:        INTEGER;
  3800.  
  3801.     PROCEDURE RedirectHelpProc;
  3802.  
  3803.         BEGIN
  3804.         WriteLn;
  3805.         WriteLn('Please supply a valid filename.  ''>>filename'' to append to the file');
  3806.         WriteLn;
  3807.         END;
  3808.  
  3809.     BEGIN
  3810.     pMoreMem := - 1;
  3811.     IF NOT gInBackground THEN
  3812.         HiliteMenu(mDebug)
  3813.     ELSE IF FALSE THEN
  3814.         InstallAnNMRequest;
  3815.  
  3816.     WHILE waiting DO
  3817.         BEGIN
  3818.         IF pAtBreak THEN
  3819.             BEGIN
  3820.             FlushEvents(keyDownMask + autoKeyMask, 0);
  3821.             pAtBreak := FALSE;
  3822.             END;
  3823.  
  3824.         {$Ifc qPerform}
  3825.         ch := GetPromptedChar(AtStr('Command'), AtStr('  BCDEFGHILMOPπQRSßTWX/'), MainHelpProc);
  3826.         {$ElseC}
  3827.         ch := GetPromptedChar(AtStr('Command'), AtStr('  BCDEFGHILMOPQRSßTWX/'), MainHelpProc);
  3828.         {$Endc}
  3829.         CASE ch OF
  3830.             '/':
  3831.                 BEGIN
  3832.                 WriteLn;
  3833.                 Write('A5: ');
  3834.                 WritePtr(GetA5);
  3835.                 Write('; thePort: ');
  3836.                 WritePtr(pSavedState.pFocusRec.Port);
  3837.                 WriteLn;
  3838.                 ShowStatus;
  3839.                 END;
  3840.  
  3841.             'B':
  3842.                 SetBreakCmd;
  3843.  
  3844.             'C':
  3845.                 ClrBreakCmd;
  3846.  
  3847.             'D':
  3848.                 BEGIN
  3849.                 IF GetPromptedNumber(AtStr('Display memory starting where?: '), asDecimal,
  3850.                    asHex) THEN
  3851.                     IF asHex <> - 1 THEN
  3852.                         ShowMemory(asHex, 16);
  3853.                 END;
  3854.  
  3855.             {$IFC IncludeDisassembler}
  3856.             '∂':
  3857.                 BEGIN
  3858.                 IF GetPromptedNumber(AtStr('Disassemble memory starting where?: '), asDecimal,
  3859.                                      asHex) THEN
  3860.                     IF asHex <> - 1 THEN
  3861.                         ShowDisasmMemory(asHex, 16);
  3862.                 END;
  3863.             {$EndC}
  3864.             'E':
  3865.                 BEGIN
  3866.                 IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
  3867.                     BEGIN
  3868.                     { Save the current script, and set it to Roman for Debugger }
  3869.                     savedScript := GetEnvirons(smKeyScript);
  3870.                     KeyScript(smRoman);
  3871.                     END;
  3872.  
  3873.                 DebugStr('Type ''G'' to return to the MacApp debugger.');
  3874.  
  3875.                 IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
  3876.                     KeyScript(savedScript);
  3877.                 END;
  3878.             'F':
  3879.                 BEGIN
  3880.                 IF GetPromptedValue(AtStr(
  3881.                                         'Fields of object [hex handle, or decimal stack level #]?: '
  3882.                                           ), asDecimal, asHex, true, gotSymbol) THEN
  3883.                     IF (asDecimal >= 0) & (asDecimal < 100) & NOT gotSymbol THEN
  3884.                         ShowFields(GetRcvrAtLevel(asDecimal, pLink), FALSE)
  3885.                     ELSE
  3886.                         ShowFields(TObject(asHex), FALSE);
  3887.                 END;
  3888.  
  3889.             'G', chSpace, chOptionSpace:
  3890.                 BEGIN
  3891.                 IF ch = 'G' THEN
  3892.                     WriteLn('go…');
  3893.                 IF which = tSysError THEN
  3894.                     BEGIN
  3895.                     str := '';
  3896.                     ShowWhich(which, str, 0);
  3897.                     WriteLn('To proceed will be fatal or will go to another debugger.');
  3898.                     waiting := NOT (GetPromptedChar(AtStr('Want to proceed'), AtStr('NY'),
  3899.                                                     stdHelpProc) = 'Y');
  3900.                     END
  3901.                 ELSE
  3902.                     waiting := FALSE;
  3903.  
  3904.                 IF NOT waiting THEN
  3905.                     BEGIN
  3906.                     gSingleStep := ch = chOptionSpace;
  3907.                     IF ch = chSpace THEN
  3908.                         pStepOverStackSize := pStackSpace
  3909.                     ELSE
  3910.                         pStepOverStackSize := 0;
  3911.                     END;
  3912.                 END;
  3913.  
  3914.             'H':
  3915.                 HeapCmd;
  3916.  
  3917.             'I':
  3918.                 BEGIN
  3919.                 IF GetPromptedValue(AtStr(
  3920.                                      'Inspect what object [hex handle, or decimal stack level #]?: '
  3921.                                           ), asDecimal, asHex, true, gotSymbol) THEN
  3922.                     IF (asDecimal >= 0) & (asDecimal < 100) & NOT gotSymbol THEN
  3923.                         ShowFields(GetRcvrAtLevel(asDecimal, pLink), true)
  3924.                     ELSE
  3925.                         ShowFields(TObject(asHex), true);
  3926.                 END;
  3927.  
  3928.             'L':
  3929.                 BEGIN
  3930.                 IF GetPromptedNumber(AtStr('Local variables of procedure [stack level #]?: '),
  3931.                                      asDecimal, asHex) THEN
  3932.                     IF asDecimal <> - 1 THEN
  3933.                         ShowLocals(asDecimal, pLink);
  3934.                 END;
  3935.  
  3936.             'M':
  3937.                 IF pMoreMem = - 1 THEN
  3938.                     WriteLn('There is no more to show.')
  3939.                 ELSE IF pMoreMem = 0 THEN
  3940.                     ShowStack
  3941.                 ELSE
  3942.                     ShowMemory(pMoreMem, 16);
  3943.  
  3944.             {$IFC IncludeDisassembler}
  3945.             'µ':
  3946.                 IF pMoreMem = - 1 THEN
  3947.                     WriteLn('There is no more to show.')
  3948.                 ELSE
  3949.                     ShowDisasmMemory(pMoreMem, 16);
  3950.             {$EndC}
  3951.             'O':
  3952.                 BEGIN
  3953.                 pQuietOutput := FALSE;
  3954.                 str := GetPromptedString(AtStr('Redirect to file?: '), RedirectHelpProc);
  3955.                 IF str <> '' THEN
  3956.                     pQuietOutput := GetPromptedChar(AtStr('Disable trace in debug window'),
  3957.                                                     AtStr('NY'), stdHelpProc) = 'Y';
  3958.  
  3959.                 IF pDebugView <> NIL THEN
  3960.                     error := pDebugView.Redirect(0, @str);
  3961.                 IF error <> noErr THEN
  3962.                     WriteLn('Error redirecting output = ', error: 1);
  3963.  
  3964.                 gReportTime := pQuietOutput;
  3965.                 END;
  3966.  
  3967.             'P':
  3968.                 BEGIN
  3969.                 IF GetPromptedNumber(AtStr('Parameters of procedure [stack level #]?: '), asDecimal,
  3970.                                      asHex) THEN
  3971.                     IF asDecimal <> - 1 THEN
  3972.                         ShowParameters(asDecimal, pLink);
  3973.                 END;
  3974.  
  3975.             {$Ifc qPerform}
  3976.             'π':
  3977.                 PerfCmd;
  3978.             {$Endc}
  3979.  
  3980.             'Q':
  3981.                 IF GetPromptedChar(AtStr('Exit to shell.  Are you sure'), AtStr('NY'),
  3982.                    stdHelpProc) = 'Y' THEN               { erase prompt }
  3983.                     BEGIN
  3984.                     { Be kind to those with TApplication.Close routines }
  3985.                     IF pSavedState.gApplication <> NIL THEN
  3986.                         gApplication := pSavedState.gApplication;
  3987.                     ExitToShell;
  3988.                     END;
  3989.  
  3990.             'R':
  3991.                 ShowRecent;
  3992.  
  3993.             'S':
  3994.                 BEGIN
  3995.                 nextLevel := 0;
  3996.                 nextFrame := pLink;
  3997.                 pNextPC := ppc;
  3998.                 ShowStack;
  3999.                 END;
  4000.  
  4001.             'ß':
  4002.                 BEGIN
  4003.                 { Get ready to blow out of debugger }
  4004.                 IF GetPromptedNumber(AtStr('Error to signal with Failure?: '), asDecimal,
  4005.                    asHex) THEN
  4006.                     BEGIN
  4007.                     error := asDecimal;
  4008.                     IF GetPromptedNumber(AtStr('Message to signal with Failure?: '), asDecimal,
  4009.                                          asHex) THEN
  4010.                         BEGIN
  4011.                         message := asDecimal;
  4012.                         gReportNext := FALSE;
  4013.  
  4014.                         { Blow }
  4015.                         Failure(error, message);
  4016.                         END;
  4017.                     END;
  4018.                 END;
  4019.  
  4020.             'T':
  4021.                 BEGIN
  4022.                 pTraceToggle := NOT pTraceToggle;
  4023.                 gTracing := pTraceToggle & pTraceEnabled;
  4024.                 ShowStatus;
  4025.                 END;
  4026.  
  4027.             'W':
  4028.                 WindCmd;
  4029.  
  4030.             'X':
  4031.                 ToggleCmd;
  4032.  
  4033.         END;
  4034.         END;
  4035.  
  4036.     IF (NOT gSingleStep) & (pStepOverStackSize = 0) & (NOT gInBackground) THEN
  4037.         HiliteMenu(0);
  4038.     END;
  4039.  
  4040. {--------------------------------------------------------------------------------------------------}
  4041. {$S MADebugger}
  4042.  
  4043. PROCEDURE MADebuggerMainEntry(aWhich: ZT;
  4044.                               aPLink, aPpc: Longint);
  4045.  
  4046.     VAR
  4047.         i:                    INTEGER;
  4048.         forgotSuccess:        BOOLEAN;
  4049.         aWho:                MAName;
  4050.         pc:                 Longint;
  4051.  
  4052.     BEGIN
  4053.     IF NOT pCanEnterDebugger THEN                        { debugger is not re-entrant. But give user
  4054.                                                          a fighting chance }
  4055.         DebugStr('Re-entering the MacApp debugger which is not re-entrant. Be careful!')
  4056.     ELSE
  4057.         pCanEnterDebugger := FALSE;
  4058.  
  4059.     { make the reason we're here available to other procs }
  4060.     which := aWhich;
  4061.     pLink := aPLink;
  4062.     ppc := aPpc;
  4063.  
  4064.     pRecentIndex := BAND(pRecentIndex + 1, kRecent);    { modulo kRecent }
  4065.     WITH pRecentPC[pRecentIndex] DO
  4066.         BEGIN
  4067.         thePC := LongIntPtr(ppc)^;
  4068.         theZT := which;
  4069.         END;
  4070.  
  4071.     IF gMastReport THEN
  4072.         CheckFreeMasters
  4073.     ELSE
  4074.         pMasters := - 1;
  4075.  
  4076.     stkBreak := (which = tBegin) & ((pStackSpace > pBreakStack) | (pProcStack > pBrProcStack));
  4077.     stepBreak := (pStackSpace <= pStepOverStackSize);    { stop only if stack is same or less for
  4078.                                                          single stepping }
  4079.  
  4080.     IF pBreakCount > 0 THEN
  4081.         BEGIN
  4082.         GetProcName(ppc, className, procName);
  4083.         IF length(className) > 0 THEN
  4084.             Delete(procName, 1, length(className) + 1);
  4085.  
  4086.         FOR i := 1 TO pBreakCount DO
  4087.             BEGIN
  4088.             pAtBreak := ((length(pBreakClass[i]) = 0) | (pBreakClass[i] = className)) & (
  4089.                         (length(pBreakProc[i]) <> 0) & (pBreakProc[i] = procName));
  4090.             IF pAtBreak THEN
  4091.                 LEAVE;
  4092.             END;
  4093.         END
  4094.     ELSE
  4095.         pAtBreak := stkBreak | stepBreak;
  4096.  
  4097.     waiting := gSingleStep | pAtBreak | (which >= tProgBreak) | IsUserBreak;
  4098.  
  4099.     { Check to see if we have too few calls to Success when leaving a procedure. This might be
  4100.     the case if the user forgot to make the call or it was missed and the handler is on the stack,
  4101.     which it usually (??? always) is. }
  4102.     forgotSuccess := ((which = tEnd) | (which = tExit)) & (StripLong(LongIntPtr(pLink)^) >=
  4103.                      StripLong(gTopHandler));
  4104.     IF forgotSuccess THEN
  4105.         BEGIN
  4106.         WriteLn(
  4107.          'You''re leaving a routine without calling Success for a handler that will be destroyed.'
  4108.                 );
  4109.         pc := gTopHandler^.failPC;
  4110.         GetMethodName(Longint(@pc), aWho);
  4111.         WriteLn('Failure handler is: ', aWho);
  4112.         waiting := true;
  4113.         END;
  4114.  
  4115.     IF gTracing | gReportNext | waiting THEN
  4116.         BEGIN
  4117.         IF pQuietOutput & NOT waiting THEN
  4118.             pDebugView.ForceOutput(WrForceOff, WrForceUnchanged)
  4119.         ELSE
  4120.             pDebugView.ForceOutput(WrForceOn, WrForceUnchanged); { force output to window }
  4121.  
  4122.         IF gReportNext & (length(gReportInfo) <> 0) THEN
  4123.             BEGIN
  4124.             WriteLn(gReportInfo);
  4125.             gReportInfo := '';
  4126.             END;
  4127.  
  4128.         IF TrcEnable(true) THEN;
  4129.  
  4130.         IF NOT waiting & gReportTime THEN
  4131.             Write(TickCount: 10, ': ');
  4132.  
  4133.         IF pAtBreak THEN
  4134.             BEGIN
  4135.             IF stkBreak THEN
  4136.                 Write('(stack space) ');
  4137.             Write('broke at ');
  4138.             END
  4139.         ELSE IF gReportNext THEN
  4140.             Write('@ ')
  4141.         ELSE IF waiting THEN
  4142.             Write('stopped at ');
  4143.  
  4144.         GetFrameInfo(pLink, ppc, callerFrame, itsFrame, receiver, className, procName, rcvrHandle,
  4145.                      rcvrClass, segNum);
  4146.         ShowWhere;
  4147.  
  4148.         IF waiting THEN
  4149.             BEGIN
  4150.             CallEnter(true, pEnterProc);
  4151.  
  4152.             {$Ifc qPerform}
  4153.             oldState := DebugPerfMonitor(FALSE);
  4154.             {$Endc}
  4155.  
  4156.             WithHideFromMacAppDo(DoWaiting, FullHide);
  4157.  
  4158.             CallEnter(FALSE, pEnterProc);
  4159.  
  4160.             {$Ifc qPerform}
  4161.             IF DebugPerfMonitor(oldState) THEN;
  4162.             {$Endc}
  4163.             END;
  4164.  
  4165.         pDebugView.EndForce;
  4166.  
  4167.         END;
  4168.  
  4169.     gReportNext := FALSE;
  4170.  
  4171.     pCanEnterDebugger := true;
  4172.  
  4173.     END;
  4174.  
  4175. {--------------------------------------------------------------------------------------------------}
  4176. {$S Main}
  4177. {$Push} {$Z+} {$%+}
  4178.  
  4179. PROCEDURE %_BP;
  4180.  
  4181.     VAR
  4182.         OldA5:                Longint;
  4183.  
  4184.     BEGIN
  4185.     OldA5 := SetCurrentA5;                                {}
  4186.     IF pCanEnterDebugger THEN
  4187.         BEGIN
  4188.         pStackSpace := ord(GetCurStackBase) - ord(GetCurStackTop);
  4189.         IF pStackSpace > gMaxStackDepth THEN
  4190.             gMaxStackDepth := pStackSpace;
  4191.  
  4192.         pProcStack := LongIntPtr(GetCurStackFramePtr)^ - Longint(GetCurStackFramePtr) - 8;
  4193.  
  4194.         MADebuggerMainEntry(tBegin, Ord4(GetCurStackFramePtr), Ord4(GetCurStackFramePtr) + 4);
  4195.         END;
  4196.     OldA5 := SetA5(OldA5);                                {}
  4197.     END;
  4198. {$Pop}
  4199.  
  4200. {--------------------------------------------------------------------------------------------------}
  4201. {$S Main}
  4202. {$Push} {$Z+} {$%+}
  4203.  
  4204. PROCEDURE %_EP;
  4205.  
  4206.     VAR
  4207.         OldA5:                Longint;
  4208.  
  4209.     BEGIN
  4210.     OldA5 := SetCurrentA5;                                {}
  4211.     IF pCanEnterDebugger THEN
  4212.         BEGIN
  4213.         pStackSpace := ord(GetCurStackBase) - ord(GetCurStackTop);
  4214.         MADebuggerMainEntry(tEnd, Ord4(GetCurStackFramePtr), Ord4(GetCurStackFramePtr) + 4);
  4215.         END;
  4216.     OldA5 := SetA5(OldA5);                                {}
  4217.     END;
  4218. {$Pop}
  4219.  
  4220. {--------------------------------------------------------------------------------------------------}
  4221. {$S Main}
  4222. {$Push} {$Z+} {$%+}
  4223.  
  4224. PROCEDURE %_EX;
  4225.  
  4226.     VAR
  4227.         OldA5:                Longint;
  4228.  
  4229.     BEGIN
  4230.     OldA5 := SetCurrentA5;                                {}
  4231.     IF pCanEnterDebugger THEN
  4232.         BEGIN
  4233.         pStackSpace := ord(GetCurStackBase) - ord(GetCurStackTop);
  4234.         MADebuggerMainEntry(tExit, Ord4(GetCurStackFramePtr), Ord4(GetCurStackFramePtr) + 4);
  4235.         END;
  4236.     OldA5 := SetA5(OldA5);                                {}
  4237.     END;
  4238. {$Pop}
  4239.  
  4240. {--------------------------------------------------------------------------------------------------}
  4241. {$S MADebugger}
  4242.  
  4243. PROCEDURE EnterMacAppDebugger;                            { called by ProgramBreak in UOBJECT }
  4244.     VAR
  4245.         notADummy:            Longint;
  4246.  
  4247.     BEGIN
  4248.     notADummy := LongIntPtr(Ord4(GetCurStackFramePtr))^;{ they called ProgramBreak called
  4249.                                                          EnterMacAppDebugger: skip a level }
  4250.     MADebuggerMainEntry(tProgBreak, notADummy, notADummy + 4);
  4251.     END;
  4252.  
  4253. {--------------------------------------------------------------------------------------------------}
  4254. {$S MADebugger}
  4255. {$Push} {$Z+}
  4256.  
  4257. FUNCTION GetErrTxt(errorCode: INTEGER): Str255;
  4258.  
  4259.     BEGIN
  4260.     GetIndString(GetErrTxt, 252, errorCode);
  4261.     END;
  4262. {$Pop}
  4263.  
  4264. {--------------------------------------------------------------------------------------------------}
  4265. {$S MADebugger}
  4266. {$Push} {$Z+}
  4267.  
  4268. VAR
  4269.     e:                    Str255;
  4270.  
  4271. PROCEDURE DebugException(errorCode: INTEGER);
  4272. { 68000 exceptions (code 901-910) and SysError calls }
  4273.  
  4274.     CONST
  4275.         kUnInitStorage1     = $72677267;                { Pascal provided uninited storage }
  4276.         kUnInitStorage2     = $67726772;                { odd byte boundary of above }
  4277.         kDebugHandleInit    = $F3F3F3F3;                { Handles are inited to this in MacApp® }
  4278.         kDebugPtrInit        = $F5F5F5F5;                { Pointers are inited to this in MacApp® }
  4279.         kDebugObjInit        = $F1F1F1F1;                { Objects are inited to this in MacApp® }
  4280.  
  4281.     VAR
  4282.         notADummy:            Longint;
  4283.         accessAddr:         Longint;
  4284.         extras:             INTEGER;
  4285.         OldA5:                Longint;
  4286.         saveResLoad:        BOOLEAN;
  4287.         saveResFile:        INTEGER;
  4288.  
  4289.     BEGIN
  4290.     OldA5 := SetCurrentA5;                                {}
  4291.     saveResLoad := GetResLoad;
  4292.     SetResLoad(TRUE);
  4293.     saveResFile := MAUseResFile(gApplicationRefNum);
  4294.  
  4295.     notADummy := ord(@notADummy) + 78;                    { Where to leave continuation address =
  4296.                                                          dummy4+link4+pc4+arg2+16*reg4 }
  4297.     LongIntPtr(notADummy)^ := pSysErrPatch.oldTrapAddr; { Tentative value (worst case & disk
  4298.                                                          inserts) }
  4299.  
  4300.     IF (errorCode = - 127) |                            { Old menu not found. }
  4301.        (errorCode = - 126) |                            { Old menu bar not found. }
  4302.        (errorCode = 30) |                                { "Please insert the disk". }
  4303.        ((errorCode >= 50) & (errorCode <= 69)) |        { SADE }
  4304.        ((errorCode >= $7FF0) & (errorCode <= $7FFF))    { Reserved for system or app use. }
  4305.        THEN
  4306.         BEGIN
  4307.         { Drop through }
  4308.         END
  4309.     ELSE
  4310.         BEGIN
  4311.         IF NOT pCanEnterDebugger THEN
  4312.             DebugStr('Re-entering the MacApp exception handler which is not re-entrant. Be careful!'
  4313.                      );
  4314.  
  4315.         { If an error happens in the debugger, give up! }
  4316.         InstallInterceptors(FALSE);
  4317.  
  4318.         EmptyHandle(pReserve);                            { we need all the space we can get }
  4319.  
  4320.         WriteLn;
  4321.  
  4322.         extras := 0;
  4323.         accessAddr := 0;
  4324.         IF (errorCode DIV 100) = 9 THEN                 { 900-9xx are 68000 exceptions, not SysErr
  4325.                                                          calls }
  4326.             BEGIN
  4327.             { Where to go after this procedure returns }
  4328.             CASE (errorCode - 900) * sizeof(Longint) OF
  4329.                 exBusError:
  4330.                     Handle(notADummy)^ := pOldexBusError;
  4331.                 exAddressError:
  4332.                     Handle(notADummy)^ := pOldexAddressError;
  4333.                 exIllegalInst:
  4334.                     Handle(notADummy)^ := pOldexIllegalInst;
  4335.                 exZeroDivide:
  4336.                     Handle(notADummy)^ := pOldexZeroDivide;
  4337.                 exCheck:
  4338.                     Handle(notADummy)^ := pOldexCheck;
  4339.                 exOverflow:
  4340.                     Handle(notADummy)^ := pOldexOverflow;
  4341.                 exLineF:
  4342.                     Handle(notADummy)^ := pOldexLineF;
  4343.             END;
  4344.  
  4345.             IF errorCode = 900 THEN
  4346.                 Write('NMI Button: ')
  4347.             ELSE
  4348.                 Write('Exception #', errorCode - 900: 1, '  ');
  4349.             errorCode := errorCode - 901;
  4350.             { Thanks to Rob Hawley for improvements to the following code }
  4351.             IF (errorCode = 1) | (errorCode = 2) | (errorCode = 3) | (errorCode = 6) THEN { Bus
  4352.                    error or Address error }
  4353.                 BEGIN
  4354.                 { 68000 and 68020 have different exception stack frames }
  4355.                 IF NOT (qNeedsMC68020 | qNeedsMC68030) & (gConfiguration.processor = env68000) THEN
  4356.                     BEGIN
  4357.                     extras := 8;                        { 68000 precedes status and PC with 4 words
  4358.                                                          }
  4359.                     accessAddr := LongIntPtr(notADummy + 6)^; { which includes the access address }
  4360.                     END
  4361.                 ELSE
  4362.                     BEGIN
  4363.                     extras := 0;                        { no extra stack frame data before status
  4364.                                                          reg & PC }
  4365.                     wrlblptr('exception frame Addr', LongIntPtr(notADummy + 4));
  4366.                     WriteLn;
  4367.                     IF (errorCode = 1) | (errorCode = 2) THEN
  4368.                         BEGIN
  4369.                         wrlblptr('PC', LongIntPtr(notADummy + 4 + 2)^);
  4370.                         WriteLn;
  4371.                         accessAddr := LongIntPtr(notADummy + 20)^; { Must add 16 - 4 to get
  4372.                                                                     offending address}
  4373.                         END
  4374.                     ELSE
  4375.                         accessAddr := LongIntPtr(notADummy + 4 + 2)^; {Same as PC}
  4376.                     END
  4377.                 END
  4378.             END
  4379.         ELSE
  4380.             Write('SysErr ID = ', errorCode: 1, '  ');
  4381.  
  4382.         CASE errorCode OF                                { All SysError argument values except where
  4383.                                                          indicated }
  4384.             0..28:
  4385.                 e := GetErrTxt(errorCode + 1);
  4386.             33:
  4387.                 e := GetErrTxt(30);
  4388.             { 30, 31: ...Disk insert... }
  4389.             41:
  4390.                 e := GetErrTxt(31);
  4391.             42:
  4392.                 e := GetErrTxt(32);
  4393.             51:
  4394.                 e := GetErrTxt(33);
  4395.             81:
  4396.                 e := GetErrTxt(34);
  4397.             84:
  4398.                 e := GetErrTxt(35);
  4399.             85:
  4400.                 e := GetErrTxt(36);
  4401.             86:
  4402.                 e := GetErrTxt(37);
  4403.             100:
  4404.                 e := GetErrTxt(38);
  4405.             MAXINT:
  4406.                 e := GetErrTxt(39);
  4407.             OTHERWISE
  4408.                 IF (32 <= errorCode) & (errorCode <= 53) THEN
  4409.                     e := GetErrTxt(40)
  4410.                 ELSE
  4411.                     e := GetErrTxt(41);
  4412.         END;
  4413.  
  4414.         WriteLn(e);
  4415.         IF accessAddr <> 0 THEN
  4416.             BEGIN
  4417.             Write('Bad address was: ');
  4418.             WritePtr(accessAddr);
  4419.             WriteLn;
  4420.             IF accessAddr = kUnInitStorage1 THEN
  4421.                 WriteLn('Appears to be Pascal provided uninitialized storage.')
  4422.             ELSE IF accessAddr = kUnInitStorage2 THEN
  4423.                 WriteLn(
  4424.                       'Appears to be Pascal provided uninitialized storage at an odd byte boundary.'
  4425.                         )
  4426.             ELSE IF accessAddr = kDebugHandleInit THEN
  4427.                 WriteLn('Appears to be Handle contents initialized by debugging.')
  4428.             ELSE IF accessAddr = kDebugPtrInit THEN
  4429.                 WriteLn('Appears to be Pointer contents initialized by debugging.')
  4430.             ELSE IF accessAddr = kDebugObjInit THEN
  4431.                 WriteLn('Appears to be uninitialized instance variable.')
  4432.             END;
  4433.         gApplication.Beep(30);                            { 1/2 second }
  4434.  
  4435.         MADebuggerMainEntry(tSysError, Ord4(GetCurStackFramePtr), Ord4(GetCurStackFramePtr) + 2 + extras);
  4436.         InstallInterceptors(true);
  4437.         END;
  4438.     IF MAUseResFile(saveResFile) = 0 THEN ;
  4439.     SetResLoad(saveResLoad);
  4440.     OldA5 := SetA5(OldA5);
  4441.     END;
  4442. {$Pop}
  4443.  
  4444.  
  4445.  
  4446. {--------------------------------------------------------------------------------------------------}
  4447. {$Push} {$IFC qTrace} {$D+} {$ENDC}
  4448. {$W+}
  4449. {$R-}
  4450. {$Init-}
  4451. {$OV-}
  4452. {$S MADebugger}
  4453.  
  4454. PROCEDURE aVBLTask;
  4455.  
  4456.     CONST
  4457.         kVBLDelay            = 15;                        { Ticks before checking }
  4458.         theOffset            = sizeof(Longint) * 2;
  4459.  
  4460.     VAR
  4461.         aKeyMap:            KeyMap;
  4462.         oldState:            INTEGER;
  4463.  
  4464.     BEGIN
  4465.  
  4466. { Set up application's A5.
  4467.   Our A5 is prepended to the QElem which is pointed at by A0 }
  4468.  
  4469.     WITH pVBLInfo DO
  4470.         pVBLInfo.aQElemWithA5.OldA5 := SetA5(VBLInfoPtr(GetParmBlockPtr - theOffset)^.aQElemWithA5.
  4471.                                              A5);
  4472.  
  4473.     oldState := IntegerPtr(JournalFlag)^;
  4474.     IntegerPtr(JournalFlag)^ := 0;                        { turn off journaling }
  4475.     GetKeys(aKeyMap);
  4476.     IntegerPtr(JournalFlag)^ := oldState;
  4477.  
  4478.     IF aKeyMap[59] & aKeyMap[55] & aKeyMap[56] & aKeyMap[58] & pCanEnterDebugger THEN
  4479.         MADebuggerMainEntry(tVBL, Ord4(GetCurStackFramePtr), Ord4(GetCurStackFramePtr) + 4);
  4480.  
  4481.     { always Reset the vblCount }
  4482.     WITH pVBLInfo DO
  4483.         BEGIN
  4484.         aQElemWithA5.q.vblQElem.vblCount := kVBLDelay;
  4485.         IF SetA5(aQElemWithA5.OldA5) = 0 THEN;            { discard the function result }
  4486.         END;
  4487.  
  4488.     END;
  4489. {$Pop}
  4490.  
  4491. {--------------------------------------------------------------------------------------------------}
  4492. {$S MAInit}
  4493.  
  4494. PROCEDURE VBLInstall;
  4495.  
  4496.     CONST
  4497.         kVBLDelay            = 15;                        { Ticks before checking }
  4498.  
  4499.     BEGIN
  4500.     IF pInterceptExceptionVectors THEN
  4501.         WITH pVBLInfo DO
  4502.             BEGIN
  4503.             { Setup the VBL task }
  4504.             WITH aQElemWithA5.q.vblQElem DO
  4505.                 BEGIN
  4506.                 qType := ord(vType);
  4507.                 vblAddr := @aVBLTask;
  4508.                 vblCount := kVBLDelay;
  4509.                 vblPhase := 0;
  4510.                 END;
  4511.             aQElemWithA5.A5 := Longint(GetA5);
  4512.             { This will make the A5 world available to the VBL task }
  4513.  
  4514.             { Install the VBL task }
  4515.             FailOSErr(VInstall(@aQElemWithA5.q));
  4516.             END;
  4517.     END;
  4518.  
  4519. {--------------------------------------------------------------------------------------------------}
  4520. {$S MADebugger}
  4521.  
  4522. PROCEDURE VBLRemove;
  4523.  
  4524. { removes the VBL task }
  4525.  
  4526.     VAR
  4527.         e:                    OSErr;
  4528.  
  4529.     BEGIN
  4530.     IF pInterceptExceptionVectors THEN
  4531.         e := VRemove(@pVBLInfo.aQElemWithA5.q);         { Discard error }
  4532.     END;
  4533.  
  4534. {--------------------------------------------------------------------------------------------------}
  4535. {$S MADebugger}
  4536.  
  4537. PROCEDURE DebugEndForce;
  4538.  
  4539.     BEGIN
  4540.     IF pDebugView <> NIL THEN
  4541.         pDebugView.EndForce;
  4542.     END;
  4543.  
  4544. {--------------------------------------------------------------------------------------------------}
  4545. {$S MADebugger}
  4546.  
  4547. PROCEDURE DebugForceOutput(DebugToWindow, DebugToFile: DebugForceOptions);
  4548.  
  4549.     BEGIN
  4550.     IF pDebugView <> NIL THEN
  4551.         pDebugView.ForceOutput(WrForceOptions(DebugToWindow), WrForceOptions(DebugToFile));
  4552.     END;
  4553.  
  4554. {--------------------------------------------------------------------------------------------------}
  4555. {$S MADebugger}
  4556.  
  4557. FUNCTION DebugRedirect(vRefnum: INTEGER;                {CONST}
  4558.                        fileName: StringPtr): OSErr;
  4559.  
  4560.     BEGIN
  4561.     IF pDebugView <> NIL THEN
  4562.         DebugRedirect := pDebugView.Redirect(vRefnum, fileName)
  4563.     ELSE
  4564.         DebugRedirect := noErr;                         {!!! think of an error to return }
  4565.     END;
  4566.  
  4567. {--------------------------------------------------------------------------------------------------}
  4568. {$S MADebugger}
  4569.  
  4570. PROCEDURE AddObjectToInspector(obj: TObject);
  4571.     EXTERNAL;
  4572.  
  4573. PROCEDURE DoToSubView(view: TView);
  4574.  
  4575.     BEGIN
  4576.     IF view.fSubViews <> NIL THEN
  4577.         AddObjectToInspector(view.fSubViews);
  4578.     AddObjectToInspector(view);
  4579.     view.EachSubView(DoToSubView);
  4580.     END;
  4581.  
  4582. PROCEDURE InitUDebugAfterIApplication;
  4583. { Call this once at the end of IApplication to finish initialization of the debugger. }
  4584.  
  4585.     BEGIN
  4586.     { do the following for each debug window }
  4587.     pDebugWindow.fNextHandler := gApplication;
  4588.     InstallIfPrintHandler(gPrintHandler, pDebugView);
  4589.  
  4590.     {$IFC qDebugTheDebugger}
  4591.     DoToSubView(pDebugWindow);
  4592.     {$ENDC}
  4593.     END;
  4594.  
  4595. {--------------------------------------------------------------------------------------------------}
  4596. {$S MADebugger}
  4597.  
  4598. PROCEDURE DebugShowTranscriptWindow;
  4599. { Call this proc from macApp to show the window }
  4600.  
  4601.     BEGIN
  4602.     IF pDebugWindow <> NIL THEN
  4603.         pDebugWindow.Open;
  4604.     END;
  4605.  
  4606. {--------------------------------------------------------------------------------------------------}
  4607. {$S MADebugger}
  4608.  
  4609. FUNCTION DebugCapture(captureProc: ProcPtr): ProcPtr;
  4610. { Install an alternative capture proc, which will get called for every
  4611. writeln. It should have the same interface as AddText. You will
  4612. probably want to set gWrToWindow to FALSE to inhibit output to the
  4613. window at the same time. Pass NIL to remove any capture proc. }
  4614.  
  4615.     BEGIN
  4616.     DebugCapture := fCaptureProc;
  4617.     fCaptureProc := captureProc;
  4618.     END;
  4619.  
  4620. {--------------------------------------------------------------------------------------------------}
  4621. {$S MADebugger}
  4622.  
  4623. FUNCTION DebugTranscriptWidth: INTEGER;
  4624. { Returns number of characters per line in current transcript window }
  4625.  
  4626.     BEGIN
  4627.     DebugTranscriptWidth := pDebugView.fCols;
  4628.     END;
  4629.  
  4630. {$EndC qDebug}
  4631. {--------------------------------------------------------------------------------------------------}
  4632. {$S Main}
  4633.  
  4634. FUNCTION DebugCanReadLn: BOOLEAN;
  4635. { Returns True if you can readln to the user }
  4636.  
  4637.     BEGIN
  4638.     DebugCanReadLn := (pDebugView <> NIL) & pDebugView.fWrToWindow & pUDebugInitialized;
  4639.     END;
  4640.  
  4641. {--------------------------------------------------------------------------------------------------}
  4642. {$S Main}
  4643.  
  4644. FUNCTION DebugCanWriteLn: BOOLEAN;
  4645. { Returns True if you can writeln to the user }
  4646.  
  4647.     BEGIN
  4648.     DebugCanWriteLn := (pDebugView <> NIL) & pUDebugInitialized;
  4649.     END;
  4650.  
  4651. {--------------------------------------------------------------------------------------------------}
  4652. {$S Main}
  4653.  
  4654. PROCEDURE GetCallersMethodName(VAR s: MAName);
  4655.  
  4656.     BEGIN
  4657.     GetMethodName(LongIntPtr(GetCurStackFramePtr)^ + 4, s); { report about our caller's caller }
  4658.     END;
  4659.  
  4660. {--------------------------------------------------------------------------------------------------}
  4661. {$S Main}
  4662.  
  4663. PROCEDURE GetMethodName(ppc: Longint;
  4664.                         VAR s: MAName);
  4665. { GetMethodName returns the name of the method (or procedure) in
  4666. which ppc points. }
  4667.  
  4668.     BEGIN
  4669.     GetProcName(ppc, discardStr, s);
  4670.     END;
  4671.  
  4672. {--------------------------------------------------------------------------------------------------}
  4673. {$S Main}
  4674.  
  4675. PROCEDURE GetProcName(ppc: Longint;
  4676.                       VAR className, procName: MAName);
  4677. { GetProcName returns the name of the procedure or function in
  4678. which ppc points.  If it is in a method, then it return's
  4679. the name of the method's class in className. }
  4680.  
  4681.     VAR
  4682.         pc, nextPC, limit:    Ptr;
  4683.         index:                INTEGER;
  4684.  
  4685.     BEGIN
  4686.     pc := Handle(ppc)^;
  4687.     IF (ord(pc) <> 0) & NOT Odd(ord(pc)) THEN
  4688.         BEGIN
  4689.         limit := Ptr(ord(pc) + 32767);
  4690.         WHILE (endOfModule(pc, limit, @procName, nextPC) = NIL) DO
  4691.             BEGIN
  4692.             IF ord(pc) >= ord(limit) THEN
  4693.                 BEGIN
  4694.                 className := '';
  4695.                 procName := '';
  4696.                 LEAVE;
  4697.                 END
  4698.             ELSE
  4699.                 pc := Ptr(ord(pc) + 2);
  4700.             END;
  4701.  
  4702.         index := pos('.', procName);
  4703.         IF index <> 0 THEN
  4704.             BEGIN
  4705.             className := copy(procName, 1, index - 1);
  4706.             END
  4707.         ELSE
  4708.             className := '';
  4709.         END
  4710.     ELSE
  4711.         BEGIN
  4712.         className := '';
  4713.         procName := '';
  4714.         END;
  4715.     END;
  4716.  
  4717. {--------------------------------------------------------------------------------------------------}
  4718. {$S MADebugger}
  4719.  
  4720. FUNCTION TrcEnable(okToTrace: BOOLEAN): BOOLEAN;
  4721. { Control whether tracing from %_BP/%_EP/%_EX is enabled or not.  Set to false when the section
  4722. of code that you are using doesn't really need to be traced (like the inspector or debugger itself).}
  4723.  
  4724.     BEGIN
  4725.     TrcEnable := pTraceEnabled;
  4726.     pTraceEnabled := okToTrace;
  4727.     gTracing := pTraceToggle & pTraceEnabled;
  4728.     END;
  4729.  
  4730. {--------------------------------------------------------------------------------------------------}
  4731. {$S MADebugger}
  4732.  
  4733. PROCEDURE IDUDebug;
  4734. { Writeln UDebug compile time. }
  4735.  
  4736.     BEGIN
  4737.     WRITELN('UDebug of 14 Feb 90 (Valentine''s Day), Compiled on ', COMPDATE, ' @ ', COMPTIME);
  4738.     END;
  4739.